Master Sheet Macro Help

[marvina2]

Hello, first time posting here.

I've got this master sheet macro that used to work to merge all my tabs into one sheet for printing purposes, but now it gives me a "Run-time error '1004: We can't paste because the Copy are and paste area aren't the same size". It only started happening as I created a new tab/sheet.

Here's the macro;

Sub Merge()
Dim ws As Worksheet
ActiveSheet.UsedRange.Offset(0).Clear
For Each ws In ActiveWorkbook.Worksheets
If ws.Name <> ActiveSheet.Name And ws.Name <> Sheets("CSI List").Name And ws.Name <> Sheets("List").Name Then
ws.UsedRange.Offset(6).Copy
With Range("A65536").End(xlUp).Offset(1)
.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

End With
End If
Next
End Sub

Any help as to why this is happening would be greatly appreciated.

 

[dmt32]

Hi,
not really different but see if this change to your code helps.

Sub Merge()
    Dim ws As Worksheet
    Dim Master As Worksheet


    Set Master = ActiveSheet
    Master.UsedRange.Offset(0).Clear


    On Error GoTo myerror
    For Each ws In ActiveWorkbook.Worksheets


        Select Case ws.Name
        Case Master.Name, "CSI List", "List"
            'do nothing
        Case Else
            ws.UsedRange.Offset(6).Copy


            With Master.Range("A" & Master.Cells(Master.Rows.Count, "A").End(xlUp).Row + 1)
                .PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
                              False, Transpose:=False
                .PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
                              False, Transpose:=False


            End With
        End Select
        Application.CutCopyMode = False
    Next ws
myerror:
    If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

To ensure code performs as required, suggest rather than use Activesheet that you reference your Master sheet by name in the code.

change this line:

Set Master = ActiveSheet

to this:

Set Master = Worksheets("Master")

Change name shown in RED to actual name.

Hope Helpful

Dave

 

[marvina2]

Hi,
not really different but see if this change to your code helps.

Sub Merge()
    Dim ws As Worksheet
    Dim Master As Worksheet


    Set Master = ActiveSheet
    Master.UsedRange.Offset(0).Clear


    On Error GoTo myerror
    For Each ws In ActiveWorkbook.Worksheets


        Select Case ws.Name
        Case Master.Name, "CSI List", "List"
            'do nothing
        Case Else
            ws.UsedRange.Offset(6).Copy


            With Master.Range("A" & Master.Cells(Master.Rows.Count, "A").End(xlUp).Row + 1)
                .PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
                              False, Transpose:=False
                .PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
                              False, Transpose:=False


            End With
        End Select
        Application.CutCopyMode = False
    Next ws
myerror:
    If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

To ensure code performs as required, suggest rather than use Activesheet that you reference your Master sheet by name in the code.

change this line:

Set Master = ActiveSheet

to this:

Set Master = Worksheets("Master")

Change name shown in RED to actual name.

Hope Helpful

Dave

Hey Dmt, I tried your macro and got a "We can't paste because the COpy area and paste area aren't the same size" error. I've uploaded my file to wetransfer (http://we.tl/ssVwrhhWwF) for reference. Not sure what I'm doing wrong, new to all of this.
Sorry wasn't sure how to upload a file to the forum.

 

[dmt32]

Sorry but I am not able view that link - Did not test code but should work ok - just a guessing are any of your sheets Grouped or some of your worksheets contain merged cells?

Dave

 

[marvina2]

My sheets aren't grouped and most my worksheets contain merged cells. Is there a way to upload a file to the forum or email you? Hard to explain without seeing it. Thanks for the help by the way!

 

[dmt32]

Welcome to any help hope it solves problem for you.

Merged cells may (or may not) be a factor.
Can only provide links to dropboxes in this Forum

as another guess try:

ws.UsedRange.Offset(6).Copy

with this:

 Application.Intersect(ws.UsedRange, ws.Cells.Resize(ws.Rows.Count - 6).Offset(6)).Copy

Dave

 

[marvina2]

https://www.dropbox.com/s/9bru59l7uz59v1l/Shop%20Drawing%20Log%20-%20BETA.xlsm

I uploaded it to dropbox instead of wetransfer, see if that works. Tried that macro, got the same error.

 

[dmt32]

Try this:

Sub Merge()
    Dim ws As Worksheet
    Dim Master As Worksheet
    Dim Lastrow As Long




    Set Master = Worksheets("Master")
    Master.UsedRange.Offset(6).Clear


    On Error GoTo myerror
    For Each ws In ActiveWorkbook.Worksheets




        Select Case ws.Name
        Case Master.Name, "CSI List", "List"
            'do nothing
        Case Else


            With ws
                Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
                If Lastrow < 11 Then GoTo nextsh
                .Range("A11:O" & Lastrow).Copy
            End With


            With Master
                Lastrow = Master.Cells(Master.Rows.Count, "A").End(xlUp).Row + 1
                If Lastrow < 6 Then Lastrow = 6


                With .Range("A" & Lastrow)
                    .PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
                                  False, Transpose:=False
                    .PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
                                  False, Transpose:=False




                End With
            End With
        End Select
nextsh:
        Application.CutCopyMode = False
    Next ws
myerror:
    If Err > 0 Then MsgBox (Error(Err)), 48, "Error"
End Sub

Dave

 

[marvina2]

That's definitely working, but it's not bringing in the header cells (A7 to A9). Anyway it can bring those in to the master? Sorry I'm being a pain

 

[dmt32]

That's definitely working, but it's not bringing in the header cells (A7 to A9). Anyway it can bring those in to the master? Sorry I'm being a pain

I thought you just wanted to merge the data? copying the header cells was most likely the cause of your problem.