Копирование VBA 2 столбца на основе значения 1 из одной рабочей книги в другую

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

Спасибо всем за ваш вклад. Код ниже работал! (Спасибо @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: я не получил опцию отладки, потому что я работал из редактора сценариев, а не из-за фактической кнопки команды. Моя ошибка.

Answer 2

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