VBA:从一张纸到另一张纸的多重复制和粘贴

时间:2015-01-22 21:28:42

标签: excel vba excel-vba

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

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

  • 从sourceSheet到destSheet中的B
  • B从sourceSheet到C in destSheet
  • C从sourceSheet到D in destSheet
  • D从sourceSheet到DE in destSheet
  • E从sourceSheet到G in destSheet
  • J从sourceSheet到H in destSheet
  • K从sourceSheet到我在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

2 个答案:

答案 0 :(得分:2)

您需要在以下逻辑上构建算法:对于您运行的每个工作表,源列为&#34; 1&#34;并且目标列是&#34; 2&#34;:在每个循环结束时,您需要将两个变量递增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)

只是使用地址将列号转换为关联的字母,并将其拆分为&#34; $&#34;。

注2

像这样的段落既无用又慢:

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

相反,尝试重新计算代码,如下所示:

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

无需选择单元格,而是直接在其属性上书写(在这种情况下,我宁愿使用.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

以上将为您选择范围&#34; A1&#34;,因为您通过了数字&#34; 1&#34;进入功能。 当然,作为您的要求更加详细,这是您应该自己学习的东西。但无论如何,这个想法是:在开头定义索引,例如indSourceindDest,然后......

indSource = indSource - 1(或-2或-3)

随意减少 使用indDest = indDest + 1(或+2,或+3)随意增加

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

答案 1 :(得分:0)

我做得更容易,通过删除行并在宏中添加了一个新的空白列并且它按照我的意愿工作,我只是将代码添加到宏中:​​

For Each sourceSheet In Worksheets

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

Next