Code to copy data from multiple worksheets

Hi All,
I've put together a code which opens a workbook and copy and pastes data into another workbook. Right now my code only selects a specified sheet to copy from (strName) but what I would like to do is copy data from each sheet in the data workbook. The sheets are named "Array 1, Array 2, Array 3, etc., etc.,. The number of sheets could vary up to 100+. I've copied the code I'm currently using below for reference. Thank you for all your help!

Sub Button6_Click()
Dim strName As String 'name of sheet to get data from
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


FilePath4 = Sheets("Hidden Data").Range("N4")
strName = Sheets("Hidden Data").Range("N5")

   
    'open a workbook
Set wbThisBook = ActiveWorkbook

   'clear contents currently in cells
wbThisBook.Worksheets("APP D Wind Data").Range("L6:BI500").Clear

   'activate the source book


Set wbTargetBook = Workbooks.Open(FilePath4)
wbTargetBook.Activate

 'select the correct map from the drop down list
wbTargetBook.Sheets(strName).Select 'selects sheet to use from workbook
wbTargetBook.Worksheets(strName).Range("D1:G1").Select
Selection.UnMerge

wbTargetBook.Worksheets(strName).Range("D1").Value = "sliding+uplift adjusted"

   'clear anything on clipboard to maximize available memory
Application.CutCopyMode = False

  'find range of cells to copy the map required
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

'Copy ballast required map data from target book
   wbTargetBook.Worksheets(strName).Range("A2:V" & intFindrowa - 1).Copy

  'Activate main workbook
wbThisBook.Activate
'
   'paste the ballast required map data in this book
wbThisBook.Sheets("APP D Wind Data").Range("AI6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wbThisBook.Sheets("APP D Wind Data").Range("AI6").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

 '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
'clear anything on clipboard to maximize available memory
Application.CutCopyMode = False
'Copy select data from target book
wbTargetBook.Sheets(strName).Range("A" & intFindrowa + 1 & ":V" & intFindrowb - 2).Copy

  'Activate main workbook
wbThisBook.Activate

   'paste the data in this book
wbThisBook.Sheets("APP D Wind Data").Range("L6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wbThisBook.Sheets("APP D Wind Data").Range("L6").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

  '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

  'clear memory
Set wbTargetBook = Nothing
Set wbThisBook = Nothing
Application.ScreenUpdating = True

End Sub

Are these the only sheets in the workbook ie there are no "Sheet1" or "General Data" or "Names of my cats" sheets in there as well as the "Array" sheets?

Hi PJ,
The first sheet in the book is "Project Summary Page". After that they are all titled "Array #".

Put the following before your "wbTargetBook.Sheets(strName).Select"

For Each Current In Worksheets
strName = Current.Name
if (left(strName,5) = "Array") then

End the If and close the Loop wherever you think is best (do you save first etc?), you'll also however need to add in a bit to paste following on from the last row used, apologies, Im not near my Excel so cant quite work that bit out.

Hi PJ,
I input your suggestion as follows but it's not indexing through the sheets. It still works to copy and paste as coded but only on sheet Array 1. Have I ended the if and loop in the wrong locations?

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


FilePath4 = Sheets("Hidden Data").Range("N4")
'strName = Sheets("Hidden Data").Range("N5")


    'open a workbook
Set wbThisBook = ActiveWorkbook

   'clear contents currently in cells
wbThisBook.Worksheets("APP D Wind Data").Range("L6:BI500").Clear

   'activate the source book


Set wbTargetBook = Workbooks.Open(FilePath4)
wbTargetBook.Activate
''
' Start loop to print 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 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

'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("AI6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wbThisBook.Sheets("APP D Wind Data").Range("AI6").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

 'clear anything on clipboard to maximize available memory
Application.CutCopyMode = False

'ActiveSheet.HPageBreaks.Add After:=Rows(66)

  '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
'clear anything on clipboard to maximize available memory
Application.CutCopyMode = False
'Copy select data from target book
wbTargetBook.Sheets(strName).Range("A" & intFindrowa + 1 & ":V" & intFindrowb - 2).Copy

  'Activate main workbook
wbThisBook.Activate

   'paste the data in this book
wbThisBook.Sheets("APP D Wind Data").Range("L6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wbThisBook.Sheets("APP D Wind Data").Range("L6").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

  'clear anything on clipboard to maximize available memory
Application.CutCopyMode = False
 
 '''''
 '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 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("BF6").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
wbThisBook.Sheets("APP D Wind Data").Range("BF6").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False


  '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