Combining Mulitple Sheets into one but it does it twice

[bernice620]

Hi All-

Below is my code to combine all the sheets into a Master Data sheet called summary. The code does what it's suppose to do but it's duplicating everything twice. I have to remove the duplicates manually. Where am I going wrong?

 Sub CombineSheets() 
   
  'This macro will copy all rows from the first sheet 
    '(including headers) 
    'and on the next sheets will copy only the data 
    '(starting on row 2) 
 
    Dim i As Integer 
    Dim j As Long 
    Dim SheetCnt As Integer 
    Dim lstRow1 As Long 
    Dim lstRow2 As Long 
    Dim lstCol As Integer 
    Dim ws1 As Worksheet 
 
    With Application 
        .DisplayAlerts = False 
        .EnableEvents = False 
        .ScreenUpdating = False 
    End With 
 
    On Error Resume Next 
 
    'Delete the Summary Sheet on the document (in case it exists) 
    Sheets("Summary").Delete 
    'Count the number of sheets on the Workbook 
    SheetCnt = Worksheets.Count 
 
    'Add the Summary Sheet 
    Sheets.Add After:=Worksheets(SheetCnt) 
    ActiveSheet.Name = "Summary" 
    Set ws1 = Sheets("Summary") 
    lstRow2 = 1 
    'Define the row where to start copying 
    '(first sheet will be row 1 to include headers) 
    j = 1 
 
    'Combine the sheets 
    For i = 1 To SheetCnt 
        Worksheets(i).Select 
 
        'check what is the last column with data 
        lstCol = ActiveSheet.Cells(1, ActiveSheet.Columns.Count).End(xlToLeft).Column 
 
        'check what is the last row with data 
        lstRow1 = ActiveSheet.Cells(ActiveSheet.Rows.Count, "A").End(xlUp).Row 
 
        'Define the range to copy 
        Range("A" & j, Cells(lstRow1, lstCol)).Select 
 
        'Copy the data 
        Selection.Copy 
        ws1.Range("A" & lstRow2).PasteSpecial 
        Application.CutCopyMode = False 
 
        'Define the new last row on the Summary sheet 
        lstRow2 = ws1.Cells(65536, "A").End(xlUp).Row + 1 
 
        'Define the row where to start copying 
        '(2nd sheet onwards will be row 2 to only get data) 
        j = 2 
    Next 
 
    With Application 
        .DisplayAlerts = True 
        .EnableEvents = True 
        .ScreenUpdating = True 
    End With 
 
    Sheets("Summary").Select 
    Cells.EntireColumn.AutoFit 
    Range("A1").Select 
 
End Sub  

[Norie]

You need to exclude the Summary worksheet.

Please Login or Register  to view this content.