Your code is copying a a range from each sheet, but lastrow is only determined on the ActiveSheet, so it misses data. Change ActiveSheet to ws.
Hi,
I have attached my file for reference.
Can anyone help me to check what is my mistakes?
Thank you.
Code:Sub CopySheets() Dim ws As Worksheet Dim lastrow As Long Application.ScreenUpdating = False For Each ws In Sheets(Array("LQ80", "LQ100", "LQ144A")) lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1 With ws .Range("A8:M" & CStr(lastrow)).Copy Worksheets("Final").Range("A" & CStr(lastrow)).PasteSpecial (xlPasteValues) End With Next ws Application.CutCopyMode = False Application.ScreenUpdating = True Columns("K:K").ColumnWidth = 9 Columns("L:L").ColumnWidth = 18 Columns("M:M").ColumnWidth = 28 Range("A1:J1").Select End Sub
Your code is copying a a range from each sheet, but lastrow is only determined on the ActiveSheet, so it misses data. Change ActiveSheet to ws.
Hope that helps
Roy
Hi royUK,
I have amended my code as below but I got different result. Data is not missing but many blank rows are inserted in the ws.
Code:Sub CopySheets() Dim ws As Worksheet Dim lastrow As Long Application.ScreenUpdating = False For Each ws In Sheets(Array("LQ80", "LQ100", "LQ144A")) lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1 With ws .Range("A8:M" & CStr(lastrow)).Copy Worksheets("Final").Range("A" & CStr(lastrow)).PasteSpecial (xlPasteValues) End With Next ws Application.CutCopyMode = False Application.ScreenUpdating = True Columns("K:K").ColumnWidth = 9 Columns("L:L").ColumnWidth = 18 Columns("M:M").ColumnWidth = 28 Range("A1:J1").Select End Sub
Bookmarks