VBA copy & paste between worksheets

0
votes

I have a small project in an excel workbook.

However, i want to copy specific cells in different worksheets to an entirely new workbook. copy and pasting each cell worksheet by worksheet looks like eternity. I could really use some help, thank you.

2
excelvba
I've done a few edits to my answer but it should be good to go. Give it a try and let me know how you make out. - Mech
Thank you so much for your reply. Really appreciate. My VBA coding skills are not that great but comments on the important lines of the code will really go a long way in helping me format it to my needs. Looking forward to reply. Cheers. - ademola adelakun
what's an upvote? - ademola adelakun

2 Answers

0
votes
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
0
votes
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