Set Range of specific columns with different used ranges in multiple sheets

[ddander54]

I'm trying to modify Ron de Bruin's CopyRangeFromMultiWorksheets() macro to copy individual columns from multiple worksheets, so I modified the code with

Set CopyRng = sh.Range("B1:B11, L1:L11, K1:K11, M1:M11")

as a test. That worked great, except each worksheet has a different number of rows.

So what I need is something like this because the last used cell in each worksheet is different, but of course the code below is causing an error on compile. The columns in each worksheet are the same, just different number of rows in each worksheet, so I'm trying to use something like this to determine the last used cell in each worksheet. Theoretically the row count of Column B is the same as L, K, M in each worksheet, so if there is a better way to do this than row counting each column that would be great.

psuedocode:

Set CopyRng = sh.Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row),& _
                                    "L1:L" & Range("L" & Rows.Count).End(xlUp).Row),& _
                                    "K1:K" & Range("K" & Rows.Count).End(xlUp).Row),& _
                                    "M1:M" & Range("M" & Rows.Count).End(xlUp).Row)

Thanks,
Don

 

[Norie]

Don

The comma should be within the quotes and you have some extra ), try this.

Set copyrng = sh.Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row & _
                                    ",L1:L" & Range("L" & Rows.Count).End(xlUp).Row & _
                                    ",K1:K" & Range("K" & Rows.Count).End(xlUp).Row & _
                                    ",M1:M" & Range("M" & Rows.Count).End(xlUp).Row)

 

[ddander54]

Norie,

Thanks for the response. Your suggestion fixed the code since the syntax is now correct, but now the code is failing further down the script.

Here is the whole macro:

Sub CopyRangeFromMultiWorksheets()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim CopyRng As Range
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    ' Delete the summary sheet if it exists.
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("MergeSheet").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True
    ' Add a new summary worksheet.
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "MergeSheet"
    ' Loop through all worksheets and copy the data to the
    ' summary worksheet.
    For Each sh In ActiveWorkbook.Worksheets
        'If sh.Name <> DestSh.Name Then
        If IsError(Application.Match(sh.Name, _
        Array(DestSh.Name, "Run Day Calendar", "RD Breakdown", "Summary - NYL", "Revised Plan - TCs for NYL"), 0)) Then

            ' Find the last row with data on the summary worksheet.
            Last = LastRow(DestSh)
            ' Specify the range to place the data.
            'Set CopyRng = sh.Range("B1:B100, L1:L100, K1:K100, M1:M100, AR1:AR100, AS1:AS100")
            Set CopyRng = sh.Range("B1:B" & Range("B" & Rows.Count).End(xlUp).Row & _
                                    ",L1:L" & Range("L" & Rows.Count).End(xlUp).Row & _
                                    ",K1:K" & Range("K" & Rows.Count).End(xlUp).Row & _
                                    ",M1:M" & Range("M" & Rows.Count).End(xlUp).Row)

            ' Test to see whether there are enough rows in the summary
            ' worksheet to copy all the data.
            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the " & _
                   "summary worksheet to place the data."
                GoTo ExitTheSub
            End If
            ' This statement copies values and formats from each
            ' worksheet.
            CopyRng.Copy    ' >>>>>>>>>>>>>>> Failing here now <<<<<<<<<<<<
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With
            ' Optional: This statement will copy the sheet
            ' name in the H column.
            DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name
        End If
    Next
ExitTheSub:
    Application.Goto DestSh.Cells(1)
    ' AutoFit the column width in the summary sheet.
    DestSh.Columns.AutoFit
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Thanks,
Don

 

[Norie]

Don

How is the code failing?

 

[ddander54]

Norie,

Sorry forgot that part.

Runtime Error 1004: This action won't work on multiple selection.