Change my macro to copy in from multiple sheets

durbs01

New Member
Joined
Jul 16, 2004
Messages
14
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:

VBA Code:
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
 

Excel Facts

What does custom number format of ;;; mean?
Three semi-colons will hide the value in the cell. Although most people use white font instead.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
14,177
Office Version
  1. 2007
Platform
  1. Windows
Try this:

VBA Code:
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
 
Solution

durbs01

New Member
Joined
Jul 16, 2004
Messages
14
Try this:

VBA Code:
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

Well-known Member
Joined
Dec 3, 2018
Messages
14,177
Office Version
  1. 2007
Platform
  1. Windows
Im glad to help you, thanks for feedback.
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,036
Messages
5,767,766
Members
425,431
Latest member
Sayson

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
Top