copy and past from multiple sheets in a separate workbook

klunker1

New Member
Joined
Nov 10, 2014
Messages
1
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!


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
 

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

Forum statistics

Threads
1,223,630
Messages
6,173,453
Members
452,514
Latest member
cjkelly15

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top