Change my macro to copy in from multiple sheets

[durbs01]

Hello friendly experts, macro newbie here!

So I have a macro I found online that is pulling in all the data from a specific worksheet in one file, and putting them in another. My question is hopefully simple - see how in the macro that the source sheet is a single named tab called E-65981097? Well is there a way for the macro to repeat this function for all worksheets in the source file excluding the first worksheet (the source file is an auto generated file which has a summary worksheet I want to ignore for these purposes), and to put the data from all these different worksheets into the same single destination worksheet?

Thanks in advance for your help!

My existing macro is below:

Sub Copy_Paste_Below_Last_Cell()
'Find the last used row in both sheets and copy and paste data below existing data.

Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim lCopyLastRow As Long
Dim lDestLastRow As Long

  'Set variables for copy and destination sheets
  Set wsCopy = Workbooks("Germany Multi_Time_and_Expense_.xlsx").Worksheets("E-65981097")
  Set wsDest = Workbooks("BvA test Germany.xlsm").Worksheets("Germany T&E Source")
    
  '1. Find last used row in the copy range based on data in column A
  lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
    
  '2. Find first blank row in the destination range based on data in column A
  'Offset property moves down 1 row
  lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row

  '3. Copy & Paste Data
  wsCopy.Range("A8:AU" & lCopyLastRow).Copy _
    wsDest.Range("A" & lDestLastRow)
End Sub

 

[DanteAmor]

Try this:

Sub Copy_Paste_Below_Last_Cell()
'Find the last used row in both sheets and copy and paste data below existing data.
  Dim wb1 As Workbook
  Dim wsCopy As Worksheet
  Dim wsDest As Worksheet
  Dim lCopyLastRow As Long
  Dim lDestLastRow As Long
  Dim n As Long
  
  Set wb1 = Workbooks("Germany Multi_Time_and_Expense_.xlsx")
  Set wsDest = Workbooks("BvA test Germany.xlsm").Worksheets("Germany T&E Source")
  
  For n = 2 To wb1.Sheets.Count
    Set wsCopy = wb1.Sheets(n)
    '1. Find last used row in the copy range based on data in column A
    lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
      
    '2. Find first blank row in the destination range based on data in column A
    'Offset property moves down 1 row
    lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
  
    '3. Copy & Paste Data
    wsCopy.Range("A8:AU" & lCopyLastRow).Copy wsDest.Range("A" & lDestLastRow)
  Next
End Sub

 

[durbs01]

Try this:

Sub Copy_Paste_Below_Last_Cell()
'Find the last used row in both sheets and copy and paste data below existing data.
  Dim wb1 As Workbook
  Dim wsCopy As Worksheet
  Dim wsDest As Worksheet
  Dim lCopyLastRow As Long
  Dim lDestLastRow As Long
  Dim n As Long
 
  Set wb1 = Workbooks("Germany Multi_Time_and_Expense_.xlsx")
  Set wsDest = Workbooks("BvA test Germany.xlsm").Worksheets("Germany T&E Source")
 
  For n = 2 To wb1.Sheets.Count
    Set wsCopy = wb1.Sheets(n)
    '1. Find last used row in the copy range based on data in column A
    lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
     
    '2. Find first blank row in the destination range based on data in column A
    'Offset property moves down 1 row
    lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
 
    '3. Copy & Paste Data
    wsCopy.Range("A8:AU" & lCopyLastRow).Copy wsDest.Range("A" & lDestLastRow)
  Next
End Sub

it worked! thank you so much

 

[DanteAmor]

Im glad to help you, thanks for feedback.