Copying range of cells in multiple workbooks into master

[excel_nomad]

Hi guys, im having trouble with a code that will the copy a range of cells from each workbook to the right of the master tab into the master tab with formattting

the cell range is B18:L542 and I want everyting but blank rows to be copied in the master tab with formatting. code is as follows:"

Sub CopyRanges()
    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 sheet "Master" if it exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("Master").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True


    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "Master"


    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then


            Last = LastRow(DestSh)


            Set CopyRng = sh.Range("B18:L542")


            If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                MsgBox "There are not enough rows in the Destsh"
                GoTo ExitTheSub
            End If

      
            CopyRng.Copy
            With DestSh.Cells(Last + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With


            DestSh.Cells(Last + 1, "H").Resize(CopyRng.Rows.Count).Value = sh.Name

        End If
    Next

ExitTheSub:

    Application.Goto DestSh.Cells(1)


    DestSh.Columns.AutoFit

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub
[HEADING=2] [/HEADING]

 

[John_w]

Try changing:

Set CopyRng = sh.Range("B18:L542")

to:

Set CopyRng = sh.Range("B18:L542").SpecialCells(xlCellTypeConstants).EntireRow