VBA копировать и вставлять между листами

Question

У меня небольшой проект в книге Excel.

Однако я хочу скопировать указанные c ячейки в разных листах в совершенно новую книгу. Копирование и вставка каждого листа ячейки по листу выглядит как вечность. Я мог бы действительно помочь, спасибо.

Answer 1

Sub test()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Dim Sourcewb As Workbook: Set Sourcewb = ThisWorkbook
Dim Destinationwb As Workbook: Set Destinationwb = Workbooks("Book2.xlsx")
Dim Sourcews As Worksheet: Set Sourcews = ThisWorkbook.Sheets
Dim Destinationws As Worksheet: Set Destinationws = Destinationwb.Worksheets("Sheet1")
Dim count As Integer

count = ThisWorkbook.Sheets.count
For i = 1 To count
For Each Sourcews In Worksheet

Sourcews.Range("A1").Copy Destination:=Destinationws.Cells(i + 1, 1)
Sourcews.Range("B1").Copy Destination:=Destinationws.Cells(i + 1, 2)

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Next

Next

End Sub

Answer 2

Sub test()
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False

    Dim Sourcewb As Workbook: Set Sourcewbwb = ThisWorkbook
    Dim Destinationwb As Workbook: Set Destinationwb = Workbooks("test.xlsm")
    Dim Sourcews As Worksheet: Set Sourcews = Sourcewb.Worksheets("Sheet1")
    Dim Destinationws As Worksheet: Set Destinationws = Destinationwb.Worksheets("Sheet2")

    Sourcews.Range("A1:A10").Copy Destination:=Destinationws.Range("A1")
    Set Sourcews = wb.Worksheets("Sheet3")
    Sourcews.Range("B11:C52").Copy Destination:=Destinationws.Range("A100")
    Set Sourcews = wb.Worksheets("Sheet4")
    Sourcews.Range("A5:R12").Copy Destination:=Destinationws.Range("B30")
    ' etc

    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
End Sub