VBA to copy all data from all sheets except one.

garypea123

Board Regular
Joined
Mar 16, 2020
Messages
130
Office Version
  1. 365
Platform
  1. Windows
Hi, I do not think I can post a file on here.

Basically what I am looing for is a VBA script to do the following.

I have say 8 sheets which data will always be changing (adding / removing) and 1 sheet which is say called combined. The headings are the same on all sheets.

What I would like the VBA script to do is:

1. take all the information from row 2 onward (row 1 is headings and not needed) but it go to the LR (last row) of data on all sheets (except combined)
2. I would like it to paste the information of all sheets into the combined tab. There should be a offset on 1 with each sheet to separate by 1 line between each sheet.

Is there a simple way of doing this? I can record the macro, and play with the script myself. But I know the Script will not be a simple as it likely should be as there seems always to be a much simple and advance way of doing something.

Any help would be great.
 

Excel Facts

Excel Wisdom
Using a mouse in Excel is the work equivalent of wearing a lanyard when you first get to college

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,643
Try:
VBA Code:
Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, ws As Worksheet
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each ws In Sheets
        If ws.Name <> "Combined" Then
            ws.UsedRange.Offset(1).Copy Sheets("Combined").Cells(Sheets("Combined").Rows.Count, "A").End(xlUp).Offset(2)
        End If
    Next ws
    Sheets("Combined").Rows(2).Delete
    Application.ScreenUpdating = True
End Sub
 

garypea123

Board Regular
Joined
Mar 16, 2020
Messages
130
Office Version
  1. 365
Platform
  1. Windows
Tha
Try:
VBA Code:
Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, ws As Worksheet
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each ws In Sheets
        If ws.Name <> "Combined" Then
            ws.UsedRange.Offset(1).Copy Sheets("Combined").Cells(Sheets("Combined").Rows.Count, "A").End(xlUp).Offset(2)
        End If
    Next ws
    Sheets("Combined").Rows(2).Delete
    Application.ScreenUpdating = True
End Sub

Try:
VBA Code:
Sub CopyData()
    Application.ScreenUpdating = False
    Dim LastRow As Long, ws As Worksheet
    LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    For Each ws In Sheets
        If ws.Name <> "Combined" Then
            ws.UsedRange.Offset(1).Copy Sheets("Combined").Cells(Sheets("Combined").Rows.Count, "A").End(xlUp).Offset(2)
        End If
    Next ws
    Sheets("Combined").Rows(2).Delete
    Application.ScreenUpdating = True
End Sub
That is perfect - My script would have been around 20x the size of that. It would have worked, but it would not have been simple at all. Its amazing how simple they can be.
 

mumps

Well-known Member
Joined
Apr 11, 2012
Messages
10,643
Glad it worked out. :)
Actually this is a little more simple:
VBA Code:
Sub CopyData()
    Application.ScreenUpdating = False
    Dim ws As Worksheet
    For Each ws In Sheets
        If ws.Name <> "Combined" Then
            ws.UsedRange.Offset(1).Copy Sheets("Combined").Cells(Sheets("Combined").Rows.Count, "A").End(xlUp).Offset(2)
        End If
    Next ws
    Sheets("Combined").Rows(2).Delete
    Application.ScreenUpdating = True
End Sub
 
Solution

Forum statistics

Threads
1,147,735
Messages
5,742,866
Members
423,760
Latest member
photogfrog

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