跨不同的工作表复制标签内容

我从SAP获取通常有40个选项卡的提取。 然后，我需要将其内容复制到另一个工作簿的其他选项卡中 – 我的模板。 该模板由40个input选项卡组成。 对于每个input标签总是有一个提取标签，其中我将粘贴的内容。 我一直在尝试用下面的代码自动化这个任务。

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 

这个代码虽然非常慢，但它的工作。 我试图在arrays上工作不运气。 你们有没有build议？ 欢呼法比

Answer 1

无需使用.Activate和.Select 。 他们让你的代码变慢。 您可能还想了解如何避免在Excel VBAmacros中使用select

如果工作表名称与Sheet1, Sheet2...Sheet40类似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 

顺便说一句，创build工作簿test的副本，并将其重命名为Test2会快得多？

编辑

我的提取有40个选项卡，每个都有一个名称。 例如Praline 1617，Total Company 1617等…然后，我将它们的内容粘贴到与原来的名称完全相同的标签中 。 所以我的模板具有相同的提取名称。 – Fabi 1分钟前

这是你想要的吗？

 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

调整For循环索引以满足您的需求：

 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 

这避免了使用Select 。

Answer 3

或者，如果工作表具有特定的名称并提高代码的可读性，则使用以下代码

 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