VBA：从一个 sheet 复制并粘贴到另一个

Question

我是 vba 的新手并创建了一个宏，该宏将工作簿中所有工作表 (sourceSheet) 的列复制到 Sheet1 (destSheet) 并在 Sheet1 中创建了一个 header ( destSheet).

当我运行按顺序排列列时它工作正常，例如 A 到 D (A:D) 但我想复制列

A 从 sourceSheet 到 destSheet 中的 B
B 从 sourceSheet 到 destSheet 中的 C
C 从 sourceSheet 到 destSheet 中的 D
D 从 sourceSheet 到 destSheet 中的 E
E 从 sourceSheet 到 destSheet 中的 G
J 从 sourceSheet 到 destSheet 中的 H
K 从 sourceSheet 到 destSheet 中的 I
O 从 sourceSheet 到 destSheet 中的 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

Answer 1

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

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

这样的函数：

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

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

注 2

像这样的一段话既无用又慢：

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

而是尝试像这样重构您的代码：

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

不需要 select 单元格，而是直接写在它的属性上（在这种情况下我宁愿使用 .Value，但你可能想使用 .FormulaR1C1，你比我懂。

在 CHRISTMAS007 解决了您的问题之后

好吧，显然这一切的关键是使用可变字母。我可能会建议您将拆分嵌入到一个将数字转换为字母的函数中：

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）

并在循环中工作以获得您想要的结果。

Answer 2

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

For Each sourceSheet In Worksheets

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

Next

VBA：从一个 sheet 复制并粘贴到另一个

VBA: multiple copy and paste from one sheet to another

excel

vba