Sub CopyDataWithoutHeaders() Dim sh As Worksheet Dim DestSh As Worksheet Dim Last As Long Dim shLast As Long Dim CopyRng As Range Dim StartRow As Long With Application .ScreenUpdating = False .EnableEvents = False End With With Sheets("Major") Application.Calculation = xlCalculationManual End With StartRow = 3 Set DestSh = Sheets("Major") With Sheets("Major") Range("A3:I5000").ClearContents Range("K3:M5000").ClearContents End With For Each sh In ActiveWorkbook.Worksheets If IsError(Application.Match(sh.Name, _ Array(DestSh.Name, "WARNING", "Major", "Main", "Users", "Table_for_report", "Final"), 0)) Then Last = Sheets("Major").Cells(Rows.Count, 1).End(xlUp).Row shLast = Lastrow(sh) If shLast > 0 And shLast >= StartRow Then Set CopyRng = sh.Range("A3", Cells(Lastrow(sh) - 1, "E")) If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then MsgBox "There are not enough rows in the Destsh" GoTo ExitTheSub End If CopyRng.Copy If DestSh.Cells(3, "A") <> "" Then With DestSh.Cells(Last + 1, "A") .PasteSpecial xlPasteValues Application.CutCopyMode = False End With Else With DestSh.Cells(3, "A") .PasteSpecial xlPasteValues Application.CutCopyMode = False End With End If End If End If If IsError(Application.Match(sh.Name, _ Array(DestSh.Name, "WARNING", "Major", "Main", "Users", "Table_for_report", "Final"), 0)) Then Set CopyRng = sh.Range("J3:M500") If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then MsgBox "There are not enough rows in the Destsh" GoTo ExitTheSub End If CopyRng.Copy If DestSh.Cells(3, "F") <> "" Then With DestSh.Cells(Last + 1, "F") .PasteSpecial xlPasteValues Application.CutCopyMode = False End With Else With DestSh.Cells(3, "F") .PasteSpecial xlPasteValues Application.CutCopyMode = False End With End If End If If IsError(Application.Match(sh.Name, _ Array(DestSh.Name, "WARNING", "Major", "Main", "Users", "Table_for_report", "Final"), 0)) Then Set CopyRng = sh.Range("W3:Y500") If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then MsgBox "There are not enough rows in the Destsh" GoTo ExitTheSub End If CopyRng.Copy If DestSh.Cells(3, "K") <> "" Then With DestSh.Cells(Last + 1, "K") .PasteSpecial xlPasteValues Application.CutCopyMode = False End With Else With DestSh.Cells(3, "K") .PasteSpecial xlPasteValues Application.CutCopyMode = False End With End If End If Next ExitTheSub: Application.Goto DestSh.Cells(1) DestSh.Columns.AutoFit With Sheets("Major") Application.Calculation = xlCalculationAutomatic Worksheets("Major").Calculate End With With Application .ScreenUpdating = True .EnableEvents = True End WithEnd Sub |
