VBA根據1的值將2列從一個工作簿復制到另一個

Question

嘗試將所選工作簿的2列（從第13行開始的“ 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設置值，僅在以下行中設置：

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

因此，您需要將其向上移動兩行代碼。

---

修改后的代碼

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：我沒有調試選項，因為我是從腳本編輯器運行的，而不是實際的命令按鈕。 我的錯。