Question

我是VBA的新手，对基本问题感到抱歉。我需要在每次迭代时创建一个循环：

将Wb1的O6：AA6复制到同一工作簿的O1：AA1
将列B：E复制到名为Wb2 N6中包含的值的工作表中的Wb1，说“DGP1”。
重复上述两个步骤：将O7：AA7复制到O1：AA1，将B：E复制到Wb2（表格名称由N7 Wb1中包含的值给出，说“DGP2”）。

我编写的代码虽然没有实现循环，也没有引用N6, N7中的值，但至少执行了我需要的计算。在定义了两个工作簿之后，它包括：

Wb1.Activate
    Range("O6:AA6").copy
    Range("O1:AA1").PasteSpecial
    Columns("B:E").copy
Wb2.Activate
    Sheets("DGP1").Select
    Selection.PasteSpecial Paste:=xlPasteValues

Wb1.Activate
    Range("O7:AA7").copy
    Range("O1:AA1").PasteSpecial
    Columns("B:E").copy
Wb2.Activate
    Sheets("DGP2").Select
    Selection.PasteSpecial Paste:=xlPasteValues

实际上我还有更多的行可以复制粘贴，我需要通过N6, N7, ...中的条目来引用最终的工作表名称。

感谢任何建议，

斯特凡诺

Answer 1

这是一个好的开始;这里有一些编写宏的技巧，可以帮助你开始工作，但也可以改进你的代码

范围 - 大部分时间，设置您的速度更快，效率更高如果范围是“目的地”范围，则“目的地”范围等于“原点”范围相同。所以，而不是做
```
Range("O6:AA6").copy
Range("O1:AA1").PasteSpecial
```
你可以做......
```
Range("O1:AA1") = Range("O6:AA6").Value
```

选择 - 您几乎不需要“选择”单元格和工作表（除非您需要）宏运行完毕后要选择的单元格/表格。最好直接参考表格。相反，再一次的

Wb1.Activate
    Range("O6:AA6").copy
    Range("O1:AA1").PasteSpecial
    Columns("B:E").copy 
Wb2.Activate
    Sheets("DGP1").Select
    Selection.PasteSpecial Paste:=xlPasteValues

假设您的数据位于Wb1的第1页，您可以执行...

Wb1.Sheets("Sheet1").Range("O1:AA1") = Wb1.Range("O6:AA6").Value
Wb2.Sheets("DGP1").Columns("B:E") = Wb1.Sheets("Sheet1").Columns("B:E").Value

For循环 - 要使用for循环，您可以设置变量并构建范围给定递增变量的字符串。例如，您可以设置变量x等于6并增加你想要的次数（让我们说5次到10次）

for x = 6 to 10
    Wb1.Sheets("Sheet1").Range("O1:AA1") = _
          Wb1.Range("O" & x & ":AA" & x).Value
    Wb2.Sheets("DGP1").Columns("B:E") = _
          Wb1.Sheets("Sheet1").Columns("B:E").Value
next x

范围/工作表参考 - 如果单元格中的值是有效范围和/或工作表的名称，则可以轻松地使用它们来构建参考该范围/表。例如， Wb1.Sheets("Sheet1").Range("N6").Value等于“DPG1” N6 Sheet1 Wb1上for x = 6 to 10 Wb1.Sheets("Sheet1").Range("O1:AA1") = _ Wb1.Range("O" & x & ":AA" & x).Value Wb2.Sheets(Wb1.Sheets("Sheet1").Range("N" & x).Value).Columns("B:E") = _ Wb1.Sheets("Sheet1").Columns("B:E").Value next x的价值。结合它与循环，您的最终代码将如下所示
```
{{1}}
```

既然已经完成了，你应该知道每次都会将不同的值O6，O7等粘贴到同一个位置（O1）。我假设这不是你想要的，但你现在也有一些工具来更新那部分。

希望这会有所帮助......

Answer 2

尝试此操作（您需要重命名工作簿名称和工作表名称）：

Sub SO_19646599()
    Dim oWB1 As Workbook, oWB2 As Workbook
    Dim oWS1 As Worksheet, oWS2 As Worksheet
    Dim oRngRef As Range, oRng1 As Range, oRng2 As Range
    Dim sTmp As String, iOffset As Long, iErr As Long, sErr As String

    ' Source Workbook and Worksheet (assumed already open)
    Set oWB1 = Workbooks("Wb1")
    Set oWS1 = oWB1.Worksheets("Sheet1") ' Assuming Sheet1
    ' Target Workbook (assumed already open)
    Set oWB2 = Workbooks("Wb2")
    ' Reference range to start
    Set oRngRef = oWS1.Range("N6")
    ' Offset counter
    iOffset = 0
    ' Loop until oRngRef is an empty cell
    Do Until IsEmpty(oRngRef)
        ' Copy O6:AA6 to O1:AA1 in Wb1 (assuming Sheet1), with row offset
        Set oRng1 = oWS1.Range("O6:AA6").Offset(iOffset, 0)
        Set oRng2 = oWS1.Range("O1:AA1").Offset(iOffset, 0)
        oRng1.Copy Destination:=oRng2
        ' Get reference to Worksheet in Wb2 by the value contained in N6 of Wb1 (assumed Sheet1), with row offset
        sTmp = oRngRef.Value
        Set oWS2 = oWB2.Worksheets(sTmp)
        If oWS2 Is Nothing Then
            iErr = iErr + 1
            sErr = sErr & iErr & vbTab & "No such """ & sTmp & """ worksheet (" & oRngRef.Address & ") in " & oWB2.Name & vbCrLf
        Else
            ' copies the columns B:E from Wb1 (Sheet1) to Wb2 (Sheet name as N6)
            oWS1.Columns("B:E").Copy Destination:=oWS2.Columns("B:E")
        End If
        iOffset = iOffset + 1
        ' Update Reference range
        Set oRngRef = oWS1.Range("N6").Offset(iOffset, 0)
    Loop
    If iErr > 0 Then
        Debug.Print sErr
        MsgBox iErr & " errors occurred, please review Immediate window." & vbCrLf & vbCrLf & sErr
    End If
    ' Cleanup
    Set oWS2 = Nothing
    Set oWB2 = Nothing
    Set oWS1 = Nothing
    Set oWB1 = Nothing
End Sub

循环遍历行并将值复制到外部文件中（由单元格值索引的工作表）

2 个答案: