VBA：从一个表格复制并粘贴到另一个表格
我是新的vba，并创build了一个macros，将工作簿中所有工作表（sourceSheet）的列复制到Sheet1（destSheet），并在Sheet1（destSheet）中创build一个头。
它运行正常，当我按顺序运行它时，像A到D（A：D），但我想复制列
- 从destSheet中的sourceSheet到B.
- B从sourceSheet到destSheet中的C.
- C从sourceSheet到D在destSheet
- D从sourceSheet到destSheet中的E.
- E从sourceSheet到destSheet中的G.
- J从sourceSheet到destSheet中的H
- K从sourceSheet到I在destSheet
- O从destSheet中的sourceSheet到J
- 我也想在destSheet的F中插入一个空行。
有人可以帮助我呢？
Sub Test() Dim sourceSheet As Worksheet 'Define Source Sheet Dim sourceRows As Integer 'Define Source Row Dim destSheet As Worksheet 'Define Destination Sheet Dim lastRow As Integer 'Define Last Row Dim sourceMaxRows As Integer 'Define Source Max Rows Dim totalRows As Integer 'Define Total Rows Dim destRange As String 'Define Destination Range Dim sourceRange As String 'Define Source Range lastRow = 1 Worksheets.Add().Name = "Sheet1" For Each sourceSheet In Worksheets If sourceSheet.Name <> "Sheet1" Then sourceSheet.Activate sourceMaxRows = sourceSheet.Cells(Rows.Count, "A").End(xlUp).Row totalRows = lastRow + sourceMaxRows - 4 Let sourceRange = "A5:D" & sourceMaxRows Range(sourceRange).Select Selection.Copy sourceSheet.Select Set destSheet = Worksheets("Sheet1") destSheet.Activate Let destRange = "B" & lastRow & ":E" & totalRows Range(destRange).Select destSheet.Paste destSheet.Select lastRow = lastRow + sourceMaxRows - 4 End If Next Rows("1:1").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("A1").Select ActiveCell.FormulaR1C1 = "Product_Id" Range("B1").Select ActiveCell.FormulaR1C1 = "Category" Range("C1").Select ActiveCell.FormulaR1C1 = "Brand" Range("D1").Select ActiveCell.FormulaR1C1 = "Model" Range("E1").Select ActiveCell.FormulaR1C1 = "EAN" Range("F1").Select ActiveCell.FormulaR1C1 = "UPC" Range("G1").Select ActiveCell.FormulaR1C1 = "SKU" Range("H1").Select ActiveCell.FormulaR1C1 = "Supplier_Shop_Price" Range("I1").Select ActiveCell.FormulaR1C1 = "Invoice_Price" Range("J1").Select ActiveCell.FormulaR1C1 = "In_Stock" Range("A1").Select MsgBox "Updated" End Sub 您需要在以下逻辑上构build一个algorithm：对于您运行的每个工作表，源列是“1”，目标列是“2”：在每个循环结束时，您需要将两个variables增加2 。下面是你的代码algorithm应该是什么样子的（我可以让你把你的特定代码重新安排到algorithm中）：
sourceColumnIndex = 1 destColumnIndex = 2 sourceColumn = Split(Cells(1, sourceColumnIndex).Address, "$")(1) destColumn = Split(Cells(1, destColumnIndex).Address, "$")(1) For Each sourceSheet In Worksheets 'do your job here: for example: '... sourceMaxRows = sourceSheet.Cells(Rows.Count, sourceColumn).End(xlUp).Row '... destRange = destColumn & lastRow & ":E" & totalRows '... 'before to go to the next, readapt the indexes: sourceColumnIndex = sourceColumnIndex + 2 destColumnIndex = destColumnIndex + 2 sourceColumn = Split(Cells(1, sourceColumnIndex).Address, "$")(1) destColumn = Split(Cells(1, destColumnIndex).Address, "$")(1) 'we can go to the next with "C" and "D", then with "E" and "F" etc. Next sourceSheet
注1
这样一个function：
sourceColumn = Split(Cells(1, sourceColumnIndex).Address, "$")(1)
只是通过使用地址并将其拆分为“$”来将列号转换为关联的字母。
笔记2
像这样的一段话是无用的，也是慢的：
Range("A1").Select ActiveCell.FormulaR1C1 = "Product_Id"
相反，试着重新考虑你的代码：
Range("A1").FormulaR1C1 = "Product_Id"
而不需要select单元格，而是直接在其属性上编写（在这种情况下，我宁愿使用.Value ，但是可能要使用.FormulaR1C1 ，你比我更清楚。
之后，圣诞节007已经清理你的问题
那么，显然这一切的关键是使用一个可变的字母。 我可能会build议你将分割embedded到函数中，用字母来转换数字：
Function myColumn(ByVal num As Integer) As String myColumn = Split(Cells(1, num).Address, "$")(1) End Function
每次使用数字。 你可以这样调用上面的函数：
num = 1 Range(myColumn(num) & 1).Select
以上将为您select范围“A1”，因为您已将数字“1”传递给函数。 当然，如果你的要求更加详细一点，这是你应该研究的东西。 但是，无论如何，这个想法是：在开始时定义索引，如indSource和indDest ，然后…
用indSource = indSource - 1 （或-2，或-3）用indDest = indDest + 1 （或+2或+3）
并在循环内工作，以获得您想要的结果。
我做的更容易，删除行，并在macros中添加一个新的空白列，它正在工作，我只是将代码添加到macros：
For Each sourceSheet In Worksheets sourceSheet.Activate Columns("F:I").Delete Columns("H:J").Delete Columns("I:N").Delete Columns("E:E").Insert Next