VBA：从一张图纸到另一张图纸的多次复制和粘贴

我是vba新手，创建了一个宏，可以将工作簿中所有工作表（sourceSheet）中的列复制到Sheet1（destSheet）中，还可以在Sheet1（destSheet）中创建标题

当我按顺序运行列时，它工作正常，比如A到D（A:D），但我想复制列

• A从源工作表到destSheet中的B
• B从源表到目的表中的C
• C从源表到数据表中的D
• D从源工作表到目的工作表中的E
• E从源工作表到目标工作表中的G
• J从源表到目标表中的H
• K从源表到目的表中的I
• O从源表到目的表中的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

子测试（）
将源工作表调整为工作表“定义源工作表”
将sourceRows设置为整数“定义源行”
将目标工作表设置为工作表“定义目标工作表”
将lastRow设置为整数“定义最后一行
将sourceMaxRows设置为整数“定义源最大行数”
Dim totalRows As Integer'定义总行数
Dim destRange作为字符串“定义目标范围”
将sourceRange设置为字符串“定义源范围”
lastRow=1
工作表.Add（）.Name=“Sheet1”
对于工作表中的每个源表
如果sourceSheet.Name为“Sheet1”，则
资料表。激活
sourceMaxRows=sourceSheet.Cells（Rows.Count，“A”）.End（xlUp）.Row
totalRows=lastRow+sourceMaxRows-4
让sourceRange=“A5:D”&sourceMaxRows
范围（sourceRange）。选择
选择，复制
资料表。选择
设置图纸=工作表（“图纸1”）
去目标，激活
让desrange=“B”&lastRow&“：E”&totalRows
范围（减小范围）。选择
粘贴
destSheet.选择
lastRow=lastRow+sourceMaxRows-4
如果结束
下一个
行（“1:1”）。选择
选择。插入Shift:=xlDown，CopyOrigin:=xlFormatFromLeftOrAbove
范围（“A1”）。选择
ActiveCell.FormulaR1C1=“产品标识”
范围（“B1”）。选择
ActiveCell.FormulaR1C1=“类别”
范围（“C1”）。选择
ActiveCell.FormulaR1C1=“品牌”
范围（“D1”）。选择
ActiveCell.FormulaR1C1=“模型”
范围（“E1”）。选择
ActiveCell.FormulaR1C1=“EAN”
范围（“F1”）。选择
ActiveCell.FormulaR1C1=“UPC”
范围（“G1”）。选择
ActiveCell.FormulaR1C1=“SKU”
范围（“H1”）。选择
ActiveCell.FormulaR1C1=“供应商\车间\价格”
范围（“I1”）。选择
ActiveCell.FormulaR1C1=“发票\价格”
范围（“J1”）。选择
ActiveCell.FormulaR1C1=“库存”
范围（“A1”）。选择
MsgBox“已更新”
端接头

您需要根据以下逻辑构建算法：对于运行的每个工作表，源列为“1”，目标列为“2”：在每个循环结束时，您需要将两个变量都增加2。下面是您的代码算法应该是什么样子的（我让您将特定代码重新排列为算法）：

注1

这一职能：

sourceColumn = Split(Cells(1, sourceColumnIndex).Address, "$")(1)

只是使用地址将列号转换为关联的字母，并将其拆分为“$”

注2

像这样的文章既没用又慢：

Range("A1").Select
ActiveCell.FormulaR1C1 = "Product_Id"

相反，试着像这样重新考虑代码：

Range("A1").FormulaR1C1 = "Product_Id"

num = 1
Range(myColumn(num) & 1).Select

无需选择单元格，而是直接在其属性上写入（在本例中，我宁愿使用

.Value

，但您可能希望使用

.formula1c1

，您比我更清楚

在那之后，圣诞节007已经清理了你的问题

很明显，这一切的关键是使用一个可变字母。我可能建议您将拆分嵌入一个函数，该函数将数字转换为字母：

Function myColumn(ByVal num As Integer) As String
    myColumn = Split(Cells(1, num).Address, "$")(1)
End Function

每次处理数字时，您可以这样调用上述函数：

Range("A1").FormulaR1C1 = "Product_Id"

num = 1
Range(myColumn(num) & 1).Select

上面将为您选择范围“A1”，因为您将数字“1”传递到函数中。 当然，如果您的请求更详细一点，这是您应该自己研究的。但无论如何，想法是：在开始时定义索引，例如

indSource

和

indDest

，然后

使用

indSource=indSource-1

（或-2或-3）随意减少它们 使用

indDest=indDest+1

（或+2或+3）随意增加它们

---

并在循环中工作以获得所需的结果。

我做得更简单，删除了行并在宏中添加了一个新的空白列，它按我的要求工作，我只是将代码添加到宏中：

For Each sourceSheet In Worksheets

    sourceSheet.Activate
    Columns("F:I").Delete
    Columns("H:J").Delete
    Columns("I:N").Delete
    Columns("E:E").Insert

Next

---

它并不总是遵循这种逻辑。我清理了他的请求（见O到J）感谢Matteo NNZ，我会玩这个，也感谢Christmas007清理了我的请求：）