Question

有人可以帮我修改此代码，以便它可以引用单元格A6中的数据并粘贴到以该数据命名的工作表中。

我已经有了一个工作宏，用于将数据从封面表粘贴到各个工作表，每天都不会覆盖以前填充的单元格（见下文）。

问题是代码过于具体，并且在将新行引入＆＃34; Balancer＆＃34;时，不容易操作。覆盖片材。以下是当前代码的示例：

Sub pastetosheet()

 r = 1
Sheets("Balancer").Range("B2").Copy
Sheets("X9X9USDFEDT6").Range("C35").End(xlUp).Offset(r, 0).PasteSpecial _
    paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Balancer").Range("D2").Copy
Sheets("X9X9USDFEDT6").Range("D35").End(xlUp).Offset(r, 0).PasteSpecial _
    paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Balancer").Range("F2").Copy
Sheets("X9X9USDFEDT6").Range("F35").End(xlUp).Offset(r, 0).PasteSpecial _
    paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Balancer").Range("G2").Copy
Sheets("X9X9USDFEDT6").Range("H35").End(xlUp).Offset(r, 0).PasteSpecial _
    paste:=xlPasteValues
Application.CutCopyMode = False
End Sub

我希望代码能够在Range＆＃34; B6＆＃34;中复制数据。在＆＃34;平衡器＆＃34;选项卡，然后将单元格中的数据引用到左侧（在本例中为A6），以找出要粘贴到哪个工作表。然后使用当前代码中已有的粘贴规则。

Answer 1

如果每一行在A列中指定了自己的目标表，则应执行以下操作：

Sub pasteToSheetOfA()
    Dim r As Long, t As Range
    With Sheets("Balancer")
        For r = 1 To .Range("B1000000").End(xlUp).Row ' for all rows of column B

            ' get the target sheet specified in column A, goto beyond last cell in C of this sheet
            Set t = Sheets(.Range("A" & r).value).Range("C1000000").End(xlUp).Offset(1)

            ' now copy the cells of the row according to the rules of the OP
            t.value = .Cells(r, "B").value
            t.Offset(,1).value = .Cells(r, "D").value
            t.Offset(,3).value = .Cells(r, "F").value
            t.Offset(,5).value = .Cells(r, "G").value
        Next
    End With
End Sub

选择粘贴目标工作表时，VBA代码将单元格引用为名称

1 个答案: