Copy and close code

[LiAD]

Hi,

I have a worksheet which uses an indirect formula to search through a series
of files/sheets based on an address to return a value from cell AE20. Once
the data has been copied for all the previous days I would like a copy/paste
values to occur to replace any of the values returned by the formula. In
AU10:AU381 there is a 1 or 0 for each row. 1 meaning that a copy/pastevalues
can be performed (decided by if the date is < today), and zero if i need to
keep the formulas.

Is it possible to have a copy/paste values code for only sheets 2-4 which
works when the file is closed to perform a copy paste values in cols AG-AU if
the value in AU=1?

Thanks
LiAD

 

[Patrick Molloy]

adapt the following code
in this I test column G , and if the value = 1 then I copy/paste values in
E:G in that row

Option Explicit

Sub CopyPaste()
Dim lastrow As Long
Dim cell As Range
Dim sheetnum As Long

lastrow = Range("E:G").SpecialCells(xlCellTypeLastCell).Row

For sheetnum = 2 To 4

With Worksheets("sheet" & sheetnum)
For Each cell In .Range(.Range("G1"), .Cells(lastrow, "G")).Cells
If cell.Value = 1 Then

With .Range(.Cells(cell.Row, "E"), .Cells(cell.Row, "G"))
.Value = .Value
End With

End If
Next
End With
Next
End Sub

 

[LiAD]

Thanks

Can't get it running but I can't see why just yet.

Took a straight copy of your code.

Does this work for you?
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i As Long, MyCell As Range
For i = 2 To 4 Step 1
With Sheets("Sheet" & i)
For Each MyCell In .Range("AU1:A" & .Range("AU" &
Rows.Count).End(xlUp).Row)
If MyCell = 1 Then
.Range(MyCell.Offset(0, -14).Address & ":" &
MyCell.Address).Value = _
.Range(MyCell.Offset(0, -14).Address & ":" &
MyCell.Address).Value
End If
Next MyCell
End With
Next i
ThisWorkbook.Save
End Sub

*How to Save a Workbook Event Macro*
1. *Copy* the macro above placing the cursor to the left of the code
box hold the *CTRL & Left Click,* then *Right Click* selected code and
*Copy.*
2. Open your Workbook and *Right Click* on any *Worksheet's Name Tab*
3. *Left Click* on *View Code* in the pop up menu.
4. Press *ALT+F11* keys to open the *Visual Basic Editor.*
5. Press *CTRL+R* keys to shift the focus to the *Project Explorer
Window*
6. Press the *Down Arrow Key* until *ThisWorkbook* is highlighted in
blue.
7. *Press* the *Enter* key to move the cursor to the *Code Window*
8. *Paste* the macro code using *CTRL+V*
9. *Save* the macro in your Workbook using *CTRL+S*

Hi,

I have a worksheet which uses an indirect formula to search through a
series
of files/sheets based on an address to return a value from cell AE20.
Once
the data has been copied for all the previous days I would like a
copy/paste
values to occur to replace any of the values returned by the formula.
In
AU10:AU381 there is a 1 or 0 for each row. 1 meaning that a
copy/pastevalues
can be performed (decided by if the date is < today), and zero if i
need to
keep the formulas.

Is it possible to have a copy/paste values code for only sheets 2-4
which
works when the file is closed to perform a copy paste values in cols
AG-AU if
the value in AU=1?

Thanks
LiAD

--
Simon Lloyd

Regards,
Simon Lloyd
'Microsoft Office Help' (http://www.thecodecage.com)
------------------------------------------------------------------------
Simon Lloyd's Profile: 1
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=178019

Microsoft Office Help

.

 

[LiAD]

Its highlighting this part in yellow:

..Range(MyCell.Offset(0, -14).Address & ":" & MyCell.Address).Value = _
..Range(MyCell.Offset(0, -14).Address & ":" & MyCell.Address).Value

I've renamed the sheets Sheet1 etc. as required. macro in correct place etc.

Any ideas?

Thanks for your help

Hi, if you followed my instructions in that post you should now have the
code in the ThisWorkbook code module and it will only run when you close
the workbook, if you are already doing that what error does it produce
if any? or does it simply do nothing when you close your workbook?, have
you made sure that your sheets sre named as i named?

Thanks

Can't get it running but I can't see why just yet.

Took a straight copy of your code.



Microsoft Office Discussion' (http://www.thecodecage.com))

--
Simon Lloyd

Regards,
Simon Lloyd
'Microsoft Office Help' (http://www.thecodecage.com)
------------------------------------------------------------------------
Simon Lloyd's Profile: 1
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=178019

Microsoft Office Help

.

 

[LiAD]

Hi,

thanks for retrying but i still can't get it to work.

The full code i'm using is

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim i As Long, MyCell As Range
For i = 2 To 4 Step 1
With Sheets("Sheet" & i)
For Each MyCell In .Range("AU10:A" & .Range("AU" & Rows.Count).End(xlUp).Row)
If MyCell = 1 Then
..Range(MyCell.Offset(0, -14).Address & ":" & MyCell.Address).Value =
..Range(MyCell.Offset(0, -14).Address & ":" & MyCell.Address).Value
End If
Next MyCell
End With
Next i
ThisWorkbook.Save
End Sub

With the disputed line all in one rather than two as shown here.

it's just come across wrong when transferred to newsgroups try this
.Range(MyCell.Offset(0, -14).Address & ":" & MyCell.Address).Value
= .Range(MyCell.Offset(0, -14).Address & ":" & MyCell.Address).Value

it should all be one line with a single dot in front of each "Range"

Its highlighting this part in yellow:

..Range(MyCell.Offset(0, -14).Address & ":" & MyCell.Address).Value = _
..Range(MyCell.Offset(0, -14).Address & ":" & MyCell.Address).Value

I've renamed the sheets Sheet1 etc. as required. macro in correct place
etc.

Any ideas?

Thanks for your help


Help - Microsoft Office Discussion' (http://www.thecodecage.com)))
Microsoft Office Discussion' (http://www.thecodecage.com))
Microsoft Office Discussion' (http://www.thecodecage.com))

--
Simon Lloyd

Regards,
Simon Lloyd
'Microsoft Office Help' (http://www.thecodecage.com)
------------------------------------------------------------------------
Simon Lloyd's Profile: 1
View this thread: http://www.thecodecage.com/forumz/showthread.php?t=178019

Microsoft Office Help

.