Copy paste macro

[Cheezwiz]

Good morning,

I am new at working with Macros and am stuck on this error.

I work for a shipping company and everyday our dispatch adds the daily calls to an excel spreadsheet. They have created one worksheet per day and I need all the data in one sheet so I can sort it and charge back our customers. I found some code online that should take the data from the various sheets and combine them into one. I tried to adjust it to my needs but I am not getting the results I need and can't figure out why.
This is what the worksheets look like

They contain between about 1 to 10 lines of data that I need transfered



This is the code I am currently working with.

Sub Compilingdata()
'
' Compilingdata Macro
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim lCopyLastRow As Long
    Dim lDestLastRow As Long
    Dim CopyRng As Range

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

 
    'Add a worksheet with the name "MonthlyMergeSheet"
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "MonthlyMergeSheet"

    'loop through all worksheets and copy the data to the DestSh
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then

            'Find the last row with data on the DestSh
            lDestLastRow = DestSh.Cells(DestSh.Rows.Count, "A").End(xlUp).Offset(1).Row

             '1. Find last used row in the copy range based on data in column A
            lCopyLastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
           
            'This example copies values/formats, if you only want to copy the
            'values or want to copy everything look at the example below this macro
            sh.Range("A4:N" & lCopyLastRow).Copy
            With DestSh.Cells(lDestLastRow + 1, "A")
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
            End With

            'Optional: This will copy the sheet name in the H column
            DestSh.Cells(lDestLastRow + 1, "O").Value = sh.Name

        End If
    Next

ExitTheSub:

    Application.Goto DestSh.Cells(1)

    'AutoFit the column width in the DestSh sheet
    DestSh.Columns.AutoFit

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

This is what I am getting

I would like it not to copy over the column headers if there is no data on the sheet as well as removing the spaces between the entries.

Thank you for the help

 

[Fluff]

How about

         If lCopyLastRow > 4 Then
            sh.Range("A4:N" & lCopyLastRow).Copy
            With DestSh.Cells(lDestLastRow, "A")
               .PasteSpecial xlPasteValues
               .PasteSpecial xlPasteFormats
               Application.CutCopyMode = False
            End With
            
            'Optional: This will copy the sheet name in the H column
            DestSh.Cells(lDestLastRow + 1, "O").Value = sh.Name
         End If
      End If
   Next

 

[Cheezwiz]

Thank you that works!

 

[Fluff]

You're welcome & thanks for the feedback.