copy tab contents across different worksheets - vba

Question

I get an extraction from SAP that usually has 40 tabs. I then need to copy their contents in other tabs across another workbook - my template. This template is made of 40 input tabs. For each input tab there is always an extracted tab which contents I will paste. I have been trying to automate this task with the following code.
Option Explicit
Sub copytabs()
Workbooks("test").Worksheets("sheet1").Range("A1:PPP999").Copy
Workbooks("test2").Worksheets("sheet1").Activate
Range("B2").Select
ActiveSheet.Paste
Workbooks("test").Worksheets("sheet3").Range("A1:PPP999").Copy
Workbooks("test2").Worksheets("sheet3").Activate
Range("B2").Select
ActiveSheet.Paste
Workbooks("test").Worksheets("sheet5").Range("A1:PPP999").Copy
Workbooks("test2").Worksheets("sheet5").Activate
Range("B2").Select
ActiveSheet.Paste
End Sub
This code does the work though very slowly. I tried to work on Array bu not luck.
Does any of you has a suggestion?
Cheers
Fabi

Answer 1

No need to use .Activate and .Select. They make your code slower. You may also want to see How to avoid using Select in Excel VBA macros
Also you can write the above code in a loop if the sheet names are like Sheet1, Sheet2...Sheet40
Option Explicit
Sub copytabs()
Dim wbI As Workbook, wbO As Workbook
Dim i As Long
Set wbI = Workbooks("test")
Set wbO = Workbooks("test2")
Application.ScreenUpdating = False
For i = 1 To 40 Step 2
wbI.Sheets("sheet" & i).Range("A1:PPP999").Copy _
wbO.Sheets("sheet" & i).Range("B2")
DoEvents
Next i
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
BTW creating a copy of workbook test and renaming it to Test2 would be much faster?
EDIT
my extraction has 40 tabs and each of them has a name. For example Praline 1617, Total Company 1617 and so on...Then I paste their contents in tabs named exactly like their original. So my template has the same tabs name of the extraction. – Fabi 1 min ago
Is this what you want?
Option Explicit
Sub copytabs()
Dim wbI As Workbook, wbO As Workbook
Dim ws As Worksheet
Set wbI = Workbooks("test")
Set wbO = Workbooks("test2")
Application.ScreenUpdating = False
For Each ws In wbI.Worksheets
ws.Range("A1:PPP999").Copy wbO.Sheets(ws.Name).Range("B2")
DoEvents
Next ws
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Answer 2

Adjust the For loop indices to match your needs:
Sub copytabs()
For i = 1 To 11 Step 2
Workbooks("test").Worksheets("sheet" & i).Range("A1:PPP999").Copy Workbooks("test2").Worksheets("sheet" & i).Range("B2")
Next i
End Sub
This avoids using Select.

Answer 3

Alternatively, in case the worksheets have specific names and to improve the readability of the code, then use the following code
Sub CopyPaste()
WSName = Array("Sheet1", "Sheet3", "Sheet5")
For n = LBound(WSName) To UBound(WSName)
With Workbooks("test").Worksheets(WSName(n)).Range("A1:PPP999")
.Copy Workbooks("test2").Worksheets(WSName(n)).Range("B2")
End With
Next
End Sub