Copy paste macro

Cheezwiz

New Member
Joined
Aug 2, 2020
Messages
2
Office Version
  1. 2010
Platform
  1. Windows
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
Dispatch summary.PNG


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



This is the code I am currently working with.

VBA Code:
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
1596378721767.png




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
 
Last edited by a moderator:

Some videos you may like

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,216
Office Version
  1. 365
Platform
  1. Windows
How about
VBA Code:
         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
 

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
48,216
Office Version
  1. 365
Platform
  1. Windows
You're welcome & thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,114,191
Messages
5,546,476
Members
410,742
Latest member
WalterSil
Top