Copy data from selection of sheets

[andysh]

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]

Have renamed Sheet1 as "Master". You can change this in the code if you desire.

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

 

[andysh]

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]

Change this line

If ws.Name <> "Master" Then

to

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]

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]

I'm surprised you get it it on that line, rather than the previous line, which should be

            ws.Range(ws.Cells(2, 1), ws.Cells(lrw, lc)).Copy

 

[andysh]

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]

Add this just before the "End If" line

ws.Range(ws.Cells(2, 1), ws.Cells(lrw, lc)).EntireRow.Delete

 

[andysh]

Works like a charm

Thanks

 

[Fluff]

Glad we could help & thanks for the feedback