VBA 根据值 1 从一个工作簿复制 2 列到另一个工作簿

Question

尝试将所选工作簿中 2 ​​列（“C”和“D”列，从第 13 行开始）的帐号和交易实例复制到我的工作簿，但前提是 D 列中的值大于1. 另外，该列的最后一行标记为“总计”，所以显然我不想包括该行。

到目前为止，这就是我所拥有的：

Private Sub CmdGetData_Click()

Dim wb As Workbook, wb2 As Workbook
Dim NewFile As Variant
Dim ws As Worksheet, ws2 As Worksheet


NewFile = Application.GetOpenFilename("Excel-files (*.xlsx*, *.xlsx*")

If NewFile <> False Then
Set wb = ThisWorkbook
Set wb2 = Workbooks.Open(NewFile)
End If

Set ws = Worksheets("Main")
Set ws2 = wb2.Worksheets("IVR Late Fee Clean Up")

        lastrow1 = ws.Cells(Rows.Count, 2).End(xlUp).Row

        For i = 13 To lastrow2
            lastrow2 = wb2.ws2.Cells(Rows.Count, 3).End(xlUp).Row
            If wb2.ws2.Range("C" & i).Value = "Grand Total" Then GoTo Skip
            If wb2.ws2.Range("D" & i).Value = "2" Then
                wb.ws.Range("B" & lastrow1 + 1).Value = wb2.ws2.Range("C" & i)
                wb.ws.Range("C" & lastrow1 + 1).Value = wb2.ws2.Range("D" & i)
            End If
        Next i
Skip:

End Sub

我遇到的问题是“运行时错误'9'：下标超出范围”。

请帮忙！

Answer 1

1. If wb2.ws2.Range("C" & i).Value = "Grand Total" Then GoTo Skip

需要：

If ws2.Range("C" & i).Value = "Grand Total" Then GoTo Skip

2.另外，

wb.ws.Range("B" & lastrow1 + 1).Value = wb2.ws2.Range("C" & i)

需要：

ws.Range("B" & lastrow1 + 1).Value = ws2.Range("C" & i)

等等……

3.最后一件事，你有一个For循环：

For i = 13 To lastrow2

但是，到目前为止，您从未为lastrow2 设置值，仅在以下行中设置了值：

lastrow2 = wb2.ws2.Cells(Rows.Count, 3).End(xlUp).Row

所以你需要将它向上移动 2 行代码。

---

修改后的代码

Option Explicit

Private Sub CmdGetData_Click()

Dim wb As Workbook, wb2 As Workbook
Dim NewFile As Variant
Dim ws As Worksheet, ws2 As Worksheet
Dim lastrow1 As Long, lastrow2 As Long, i As Long

NewFile = Application.GetOpenFilename("Excel-files (*.xlsx*, *.xlsx*")

If NewFile <> False Then
    Set wb = ThisWorkbook
    Set wb2 = Workbooks.Open(NewFile)

    '====== ALL this code below needs to be inside the If NewFile <> False Then part =====

    Set ws = wb.Worksheets("Main")
    Set ws2 = wb2.Worksheets("IVR Late Fee Clean Up")

    lastrow1 = ws.Cells(Rows.Count, 2).End(xlUp).Row
    lastrow2 = ws2.Cells(Rows.Count, 3).End(xlUp).Row

    For i = 13 To lastrow2
        If ws2.Range("C" & i).Value = "Grand Total" Then Exit For

        If ws2.Range("D" & i).Value = "2" Then
            ws.Range("B" & lastrow1 + 1).Value = ws2.Range("C" & i).Value
            ws.Range("C" & lastrow1 + 1).Value = ws2.Range("D" & i).Value
        End If
    Next i
End If

End Sub

Answer 2

感谢大家的意见。下面的代码有效！ （谢谢@ShaiRado）

Private Sub CmdGetData_Click()

Dim wb As Workbook, wb2 As Workbook
Dim NewFile As Variant
Dim ws As Worksheet, ws2 As Worksheet


NewFile = Application.GetOpenFilename("Excel-files (*.xlsx*, *.xlsx*")

If NewFile <> False Then
Set wb = ThisWorkbook
Set wb2 = Workbooks.Open(NewFile)
End If

Set ws = wb.Sheets("Main")
Set ws2 = wb2.Sheets("IVR Late Fee Clean Up")

        lastrow1 = ws.Cells(Rows.Count, 2).End(xlUp).Row
        lastrow2 = ws2.Cells(Rows.Count, 3).End(xlUp).Row

        For i = 13 To lastrow2
            If ws2.Range("C" & i).Value = "Grand Total" Then GoTo Skip
            If ws2.Range("D" & i).Value = "2" Then
                ws.Range("B" & lastrow1 + 1).Value = ws2.Range("C" & i)
                ws.Range("C" & lastrow1 + 1).Value = ws2.Range("D" & i)
            End If
        Next i
Skip:

End Sub

还有@Ryszard：我没有得到调试选项，因为我是从脚本编辑器运行的，而不是实际的命令按钮。我的错。