Copy data from multiple identical sheets to a consolidation sheet by macro

Mel Smith

Well-known Member
Joined
Dec 13, 2005
Messages
1,023
Office Version
  1. 365
Platform
  1. Windows
I have a workbook consisting of 9 sheets. The layout of each sheet is identical. Sheet 1 (named Combined report) and sheets 2 to 9 will auto-name based on the employees name
which I shall enter into cell A3 as each new sheet is taken into use.

What I would like to do is to have a macro or command button that will copy the contents of each sheet (sheets 2-9) and paste them onto sheet 1 (Combined report) in sheet order, i.e. starting at
cell A4, copy sheet 2, however many lines that may be, and then sheet 3 and so on until all sheets (2 - 9) and copied and pasted.

The data on each sheet to be copied is within the range A4:L4 but the number of rows is variable. It might be one row or 20 rows.

Any help will be very much appreciated!

Mel
 
Hi Fluff,

No, it "steps over"

If Ws.Name <> wsCom.Name Then
to

End If

Mel
 
Upvote 0

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
What I've found is that it steps over and goes through each line of the "tab naming" code contained in "This Workbook"


Mel
 
Upvote 0
It should only do that if you are changing the value of A3
 
Upvote 0
In an effort to prevent that, in the tab naming code I've changed A3 to A1 but that hasn't enabled the macro to paste, though.

This is the tab naming code:
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.Name = ws.Range("A1").Value
Next ws
End Sub

And this is the 'paste' code:
Sub Mel_Smith()
Dim ws As Worksheet, wsCom As Worksheet
Dim UsdRws As Long

Set wsCom = Sheets("Combined Report")
For Each ws In Worksheets
If ws.Name <> wsCom.Name Then
UsdRws = ws.Range("B" & Rows.Count).End(xlUp).Row
If UsdRws > 3 Then ws.Range("A4:L" & UsdRws).Copy wsCom.Range("B" & Rows.Count).End(xlUp).Offset(1, -1)
End If
Next ws
End Sub


Mel
 
Upvote 0
Do you have the code to copy the data in a standard module?
 
Upvote 0
Hi Fluff,

When in Module 1, pressing F8, it jumps from "If ws.Name <> wsCom.Name" Then" to "End If" and then "Next ws" and then returns to "If ws.Name <> wsCom.Name" and then goes to "UsdRws = ws.Range("B" & Rows.Count).End(xlUp).Row" then "If UsdRws > 3 Then "ws.Range("A4:L" & UsdRws).Copy wsCom.Range("B" & Rows.Count).End(xlUp).Offset(1, -1)" and then, for some odd reason steps through the tab naming code in "ThisWorkbook"

I hope this is of help.

Mel
 
Upvote 0
Fi Fluff,

I've commented out the tab naming code to see what effect it might have and then tried the command button and it came up with the following error: "Can't execute code in break mode" and it stopped at "Next ws"

Mel
 
Upvote 0
That sounds as though it's changing a3 on the combined sheet. Try
VBA Code:
Sub MelSmith()
   Dim Ws As Worksheet, wsCom As Worksheet
   Dim UsdRws As Long, DestRw As Long
   
   Set wsCom = Sheets("Combined Report")
   DestRw = wsCom.Range("B" & Rows.Count).End(xlUp).Offset(1)
   If DestRw < 4 Then DestRw = 4
   For Each Ws In Worksheets
      If Ws.Name <> wsCom.Name Then
         UsdRws = Ws.Range("B" & Rows.Count).End(xlUp).Row
         If UsdRws > 3 Then
            Ws.Range("A4:L" & UsdRws).Copy wsCom.Range("A" & DestRw)
            DestRw = DestRw + UsdRws - 3
         End If
      End If
   Next Ws
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,213,536
Messages
6,114,208
Members
448,554
Latest member
Gleisner2

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