Копирование данных с нескольких листов на 1 лист

Question

Я пытаюсь скопировать определенные c ячейки (от I106 до I160) из нескольких листов в первый лист. Каждый должен быть скопирован рядом друг с другом в новом столбце. Однако он копирует данные друг под другом в 1 столбец.

Заранее спасибо

Sub CopyIt()

    Dim ws As Worksheet
    Application.ScreenUpdating = False
    For Each ws In ActiveWorkbook.Worksheets
        If ws.name <> "All Data" Then
            ws.Range("I106:I160").Copy
            Sheets("All Data").Cells(Rows.Count, "B").End(xlUp).Offset(1).PasteSpecial xlPasteValues
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Answer 1

Попробуйте это:

Sub CopyIt()

    Dim ws As Worksheet, c As Range, wsData As Worksheet, wb As WorkBook
    Set wb = ActiveWorkbook
    Set wsData = wb.Sheets("All Data")
    Application.ScreenUpdating = False
    Set c = wsData.Cells(Rows.Count, "B").End(xlUp).Offset(1) 'start here
    For Each ws In wb.Worksheets
        If ws.name <> wsData.Name Then
            With ws.Range("I106:I160")
                c.Resize(.Rows.Count, .Columns.Count).Value = .Value
            End With
            Set c = c.offset(0, 1)'next column 
        End If
    Next
    Application.ScreenUpdating = True
End Sub