简体   繁体   中英

VBA Copy 2 Columns based on value of 1 From One Workbook to Another

Trying to copy account numbers and instances of a transaction from 2 columns (Columns "C" and "D", beginning at row 13) in a selected workbook to my workbook, but only if the value in Column D is greater than 1. Also, the last row in the column is labeled "Grand Total", so obviously I want to not included that row.

So far, this is what I have:

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

The problem I am getting is "Run-time error '9': Subscript out of range".

Please help!

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

needs to be:

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

2. Also,

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

needs to be:

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

etc...

3. And, one last thing, you have a For loop:

For i = 13 To lastrow2

But , you never set a value for lastrow2 up to this point, only at the following line you have:

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

So you need to move that up 2 lines of code.


Modified Code

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

Thank you all for your input. The code below worked! (Thank you @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

And @Ryszard: I didn't get the debug option because I was running from the script editor, not the actual command button. My mistake.

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM