Macro that loops through each sheet and copy Usedrange (except first row) to a destination sheet

[Ellie3457]

Hello everyone,

I am a beginner in writing VBA code and am encountering issues with a code I wrote. (included below)

I have a workbook with multiple sheets. Some with variable names like "Region A", "Region B", "Region 123" etc. Some sheets' names do not contain the word "Region" at all.
The goal of my macro is combining the data of all sheets with a name starting with "Region" to a newly created sheet.

I want to copy the data (except the headers) of each sheet with a name starting with "Region" to a newly created sheet called "Main". The data is variable so I cannot reference a specific range because in sheet "Region A" there might be 36 rows and 145 rows in "Region B". The number of columns and the headers in the sheets with a name starting with "Region" are always the same.

I know one of the issue with my code here is with the "ws.Activate" before the if statement, which activates all the worksheets and not only the ones I am interested in, which apparently causes issues when pasting but I do not have the knowledge yet to fix it.

I also wanted to try to avoid referencing to ActiveSheet but I did not find a way.

I unfortunately cannot share the workbook as it is confidential data. If needed I can create a workbook with fake data.

I would really appreciate if someone could help. Thanks in advance!

Ellie

Sub Copy_to_Main_Test()

'The macro will be stored in a different workbook than the one it will be used in
Dim mainWB As Workbook
Set mainWB = ActiveWorkbook
Dim ws As Worksheet
Dim LastRow As Long
Dim rng As Range


mainWB.Activate
'Adding the sheet "Main" which is the destination sheet where all the data from the other sheets should be copied to
Sheets.Add.Name = "Main"
'Adding headers that match the headers in the other sheets with name starting with "Region"
Range("A1").Value = "Header 1"
Range("B1").Value = "Header 2"
Range("C1").Value = "Header 3"


For Each ws In ActiveWorkbook.Worksheets
ws.Activate
Set rng = ActiveSheet.UsedRange
Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
If ws.Name Like "Profile *" Then rng.Copy
Sheets("Main").Activate
Sheets("Main").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Next ws


End Sub

 

[Fluff]

Hi & welcome to MrExcel.
How about

Sub Ellie()
   Dim Ws As Worksheet, MainWs As Worksheet
   
   Set MainWs = Sheets.Add.Name = "Main"
   MainWs.Range("A1:C1").Value = Array("Header 1", "Header 2", "Header 3")
   For Each Ws In Worksheets
      If Ws.Name Like "Region*" Then
         Ws.UsedRange.Offset(1).Copy MainWs.Range("A" & Rows.Count).End(xlUp).Offset(1)
      End If
   Next Ws
End Sub

 

[Ellie3457]

Hi Fluff,

Thank you so much for the quick response and solution! This works perfectly!

I also learned a few things from the way you wrote that code, so I really appreciate your help

Thanks again and have a nice day!

Ellie

 

[Fluff]

Glad to help & thanks for the feedback.