My goal is to automatically copy a range of columns (A:C) from 40+ Excel Sheet into one Sheet located in the same workbook.
The structure of all sheets is identical. Columns consist of numeric values. I want the columns to be added to the right at each iteration (so the target sheet will be enriched horizontally with the data)
My attempt (see the code below) is not automated as if I have to specify Sheet Names and Target Cell where it is possible to copy the columns
Sub macro() Sheets("Top").Select Columns("A:C").Select Selection.Copy Sheets("Low").Select Range("D1").Select ActiveSheet.Paste End Sub
Any help is appreciated! Thank you
Please, try the next code. It will iterate between all existing sheets and copy all rows of columns "D:K" from all sheets in one named "Destination" (starting from "A1"). If you need it to start from "D1" it would be easy to adapt the code:
Sub copyAllSheetsInOne() Dim ws As Worksheet, sh As Worksheet, lastRow As Long, lastEmptyCol As Long, i As Long Set sh = Worksheets("Destination") 'a sheet named "Destination" must exist in the workbook to be processed sh.cells.ClearContents 'clear its content (for cases when code run before) 'some optimization to make the code faster: Application.DisplayAlerts = False: Application.EnableEvents = False Application.Calculation = xlCalculationManual 'iterate between all existing sheets: For Each ws In ActiveWorkbook.Worksheets If ws.name <> "Destination" Then lastEmptyCol = sh.cells(1, sh.Columns.count).End(xlToLeft).Column + 1 lastRow = ws.Range("D" & ws.rows.count).End(xlUp).row If lastEmptyCol = 2 Then lastEmptyCol = 1 'for the first sheet ws.Range("D1", ws.Range("K" & lastRow)).Copy sh.cells(1, lastEmptyCol) End If Next ws Application.DisplayAlerts = True: Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic End Sub