Hi all,
I've been able to put together the following code with the help of many post by other members.
Problem:
I need to modify the code to copy the same range of data from multiple sheets into a summary sheet which is located in a different workbook. I cannot get the following code to run through all the sheets in the target workbook. I only get the first sheet. I've been pulling my hair out and searching the forum but I cannot find a problem like this....
Anticipated corrections needed?:
1. Does not cycle through all sheets in the wbTargetBook. Currently only the sheet called out by (Filepath4) gets copied and pasted. I imagine I will need to get rid of this line in order to cycle through the other sheets in the workbook.
2. I always want wbThisBook to be the book I am pasting the data to. How can I code that?
3. Currently, if the code was working it would paste data on top of earlier pasted data. That is fine as I'm just trying to get the code to copy and paste from each sheet. Ideally, the for statement would include a line to skip 30 columns when pasting the next sheets data. I don't want to get too greedy with the requests so the top 1 is most important.
Thank you all and PLEASE HELP!
I've been able to put together the following code with the help of many post by other members.
Problem:
I need to modify the code to copy the same range of data from multiple sheets into a summary sheet which is located in a different workbook. I cannot get the following code to run through all the sheets in the target workbook. I only get the first sheet. I've been pulling my hair out and searching the forum but I cannot find a problem like this....
Anticipated corrections needed?:
1. Does not cycle through all sheets in the wbTargetBook. Currently only the sheet called out by (Filepath4) gets copied and pasted. I imagine I will need to get rid of this line in order to cycle through the other sheets in the workbook.
2. I always want wbThisBook to be the book I am pasting the data to. How can I code that?
3. Currently, if the code was working it would paste data on top of earlier pasted data. That is fine as I'm just trying to get the code to copy and paste from each sheet. Ideally, the for statement would include a line to skip 30 columns when pasting the next sheets data. I don't want to get too greedy with the requests so the top 1 is most important.
Thank you all and PLEASE HELP!
Code:
Dim strName As String
Dim wbThisBook As Workbook 'workbook where the data is to be pasted
Dim wbTargetBook As Workbook 'workbook from where the data is to copied
Dim intFindrowa As Integer
Dim rngFinda As Range
Dim intFindrowb As Integer
Dim rngFindb As Range
Dim intFindrowc As Integer
Dim rngFindc As Range
Dim lastRow As Long
FilePath4 = Sheets("Hidden Data").Range("N4")
'strName = Sheets("Hidden Data").Range("N5")
'open a workbook
Set wbThisBook = ActiveWorkbook
Set wbTargetBook = Workbooks.Open(FilePath4)
wbTargetBook.Activate
''
' Start loop to copy data for each array ''''''''''''''
'
For Each Current In Worksheets
strName = Current.Name
If (Left(strName, 5) = "Array") Then
'select the correct map from the drop down list
wbTargetBook.Sheets(strName).Select
wbTargetBook.Worksheets(strName).Range("D1:G1").Select
Selection.UnMerge
wbTargetBook.Worksheets(strName).Range("D1").Value = "Windzone"
'clear anything on clipboard to maximize available memory
Application.CutCopyMode = False
'
'Find range of cells to copy the module index map
With wbTargetBook.Sheets(strName)
Set rngFindb = wbTargetBook.Sheets(strName).Range("B:B").Find(What:="Windzone", LookIn:=xlValues)
If Not rngFindb Is Nothing Then
intFindrowb = rngFindb.Row
End If
End With
'''
'find range of cells to copy the Windzone map
With wbTargetBook.Worksheets(strName).Select
Set rngFinda = wbTargetBook.Worksheets(strName).Range("A:A").Find(What:="Module Index", LookIn:=xlValues)
If Not rngFinda Is Nothing Then
intFindrowa = rngFinda.Row
End If
End With
'''
'Find range of cells to copy the Ballast Data
With wbTargetBook.Sheets(strName)
Set rngFindc = wbTargetBook.Sheets(strName).Range("H:H").Find(What:="Uplift Trib", LookIn:=xlValues)
If Not rngFindc Is Nothing Then
intFindrowc = rngFindc.Row
End If
End With
'''
'clear anything on clipboard to maximize available memory
Application.CutCopyMode = False
'
'Copy select Module Index data from target book
wbTargetBook.Sheets(strName).Range("A" & intFindrowa + 1 & ":V" & intFindrowb - 2).Copy
'
'Activate main workbook
wbThisBook.Activate
'
'paste the Module Index data in this book
wbThisBook.Sheets("APP D Wind Data").Range("A6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wbThisBook.Sheets("APP D Wind Data").Range("A6").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'
'clear anything on clipboard to maximize available memory
Application.CutCopyMode = False
'
'Copy Windzone map data from target book
wbTargetBook.Worksheets(strName).Range("A2:V" & intFindrowa - 1).Copy
'
'Activate main workbook
wbThisBook.Activate
'
'paste the Windzone map data in thisbook
wbThisBook.Sheets("APP D Wind Data").Range("A50").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wbThisBook.Sheets("APP D Wind Data").Range("A50").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'
'clear anything on clipboard to maximize available memory
Application.CutCopyMode = False
'
'Copy Ballast data from target book
wbTargetBook.Sheets(strName).Range("A" & intFindrowc + 1 & ":K500").Copy
'
'Activate main workbook
wbThisBook.Activate
'paste the ballast data in this book
wbThisBook.Sheets("APP D Wind Data").Range("A96").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wbThisBook.Sheets("APP D Wind Data").Range("A96").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
'
'Find Last Row used for Data
lastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
'
'Break sheet below last row
ActiveSheet.HPageBreaks.Add Before:=Rows(lastRow)
'
'clear anything on clipboard to maximize available memory
Application.CutCopyMode = False
'
'save the target book
wbTargetBook.Save
'
'close the workbook
wbTargetBook.Close
'
'activate the source book again
wbThisBook.Activate
'go back to main input sheet
Sheets("Data Input").Activate
Application.ScreenUpdating = True
'
'clear memory
Set wbTargetBook = Nothing
Set wbThisBook = Nothing
End If
'''
Next
'''
End Sub