Copy data from selection of sheets

andysh

New Member
Joined
Nov 8, 2019
Messages
30
Hi

I'm trying to collate the data from sheets 2 through 11 onto sheet 1 of a workbook but I'm struggling with the macro.

How would I go about cutting and pasting the rows with data from sheets 2 to 11 (without headers) on to the next available row on sheet 1?
 

alansidman

Well-known Member
Joined
Feb 26, 2007
Messages
5,032
Office Version
2019
Platform
Windows
Have renamed Sheet1 as "Master". You can change this in the code if you desire.
Code:
Option Explicit


Sub cpypste()
    Dim ws As Worksheet, sh As Worksheet
    Set sh = Sheets("Master")
    Dim lr As Long, lrw As Long, lc As Long
    Application.ScreenUpdating = False
    For Each ws In Worksheets
        If ws.Name <> "Master" Then
            lrw = ws.Range("A" & Rows.Count).End(xlUp).Row
            lc = ws.Cells(1, Columns.Count).End(xlToLeft).Column
            lr = sh.Range("A" & Rows.Count).End(xlUp).Row + 1
            ws.Range(Cells(2, 1), Cells(lrw, lc)).Copy
            sh.Range("A" & lr).PasteSpecial xlPasteValues
        End If
    Next ws
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox "completed"
End Sub
 
Last edited:

andysh

New Member
Joined
Nov 8, 2019
Messages
30
Thanks for your help Alan

On the line 'lrw = ws.Range("A" & Rows.Count).End(x1Up).Row' I'm getting a variable not defined error on (x1Up)

Also, I should have mentioned I need it to ignore sheet12(Lists) which contains the lists for drop-downs
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,101
Office Version
365
Platform
Windows
Change this line
Code:
If ws.Name <> "Master" Then
to
Code:
If ws.Name <> "Master" And ws.Name <> "Lists" Then
and to correct the error it should be xlup not x1up (ie lower case L, not number one)
 

andysh

New Member
Joined
Nov 8, 2019
Messages
30
Please ignore last error, sorted it but I get an error "Method 'Range' of object '_Worksheet' failed" on the line "sh.Range("A" & lr).PasteSpecial xlPasteValues"
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,101
Office Version
365
Platform
Windows
I'm surprised you get it it on that line, rather than the previous line, which should be
Code:
            ws.Range(ws.Cells(2, 1), ws.Cells(lrw, lc)).Copy
 

andysh

New Member
Joined
Nov 8, 2019
Messages
30
Awesome, nearly there

It's leaving the data on the original sheets though, ideally I need it to cut the rows or delete them after copy
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,101
Office Version
365
Platform
Windows
Add this just before the "End If" line
Code:
ws.Range(ws.Cells(2, 1), ws.Cells(lrw, lc)).EntireRow.Delete
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
30,101
Office Version
365
Platform
Windows
Glad we could help & thanks for the feedback
 

Forum statistics

Threads
1,077,614
Messages
5,335,253
Members
399,009
Latest member
twcaddell

Some videos you may like

This Week's Hot Topics

Top