Excel VBA-将两列从一个工作簿复制并粘贴到另一个工作簿

Question

I'm new to vba. But, I have a big problem we're trying to solve at work. We receive payments for services that come through a commuter pretax deduction program. This is usually around 160+ payments that we have to enter into three systems. I've built a spreadsheet that cuts down on errors when we enter deposits. But, I'm trying to import the payments from the commuter program into my spreadsheet to cut out about an hour(or two) of data entry. The spreadsheet that I'm trying to import it to is an excel table. I'm trying to copy and paste two columns. I would like column D(Account #'s) in the "WAGEWORKS IMPORT" spreadsheet to only copy the used cells in column G and paste them into the active workbook in column B, and, copy the used cells in Column D($ Amt. of Payments) and paste them into the active workbook in Column I(The active workbook is ThisWorkbook-the bookkeeper will use a command button that I will assign later after I perfect the code) I can only get it to copy the cells from column G and copy them into the cells in Column B. The cells from Column D are getting pasted into column I, however they are doing so at the end of the table which is 600+ rows below where I need them. I need the corresponding payments to match the account numbers in the same row. My code is below. Can anyone help?

Sub Wageworks_Import()
Application.ScreenUpdating = False

Dim lastrow As Long, erow As Long


Set x = Workbooks.Open("J:\Accounting - Copy\Accounting Projects\Wageworks Import\WAGEWORKS IMPORT.xlsx")

Workbooks.Open("J:\Accounting - Copy\Accounting Projects\Wageworks Import\WAGEWORKS IMPORT.xlsx").Activate


Sheets("index").Range("G10:G100").Copy


ThisWorkbook.Activate
Sheets("ENTRY").Select
Set lastCell = ActiveSheet.Cells(Rows.Count, "B").End(xlUp)
If IsEmpty(lastCell.Value) Then
  Set lastCell = lastCell.End(xlUp)
End If
lastrow = lastCell.Row + 1
Range("B" & lastrow).Select
Selection.PasteSpecial xlPasteValues


Workbooks.Open("J:\Accounting - Copy\Accounting Projects\Wageworks Import\WAGEWORKS IMPORT.xlsx").Activate


Sheets("index").Range("D10:D100").Copy

ThisWorkbook.Activate
Sheets("ENTRY").Select
Set lastCell = ActiveSheet.Cells(Rows.Count, "I").End(xlUp)
If IsEmpty(lastCell.Value) Then
  Set lastCell = lastCell.End(xlUp)
End If
lastrow = lastCell.Row + 1
Range("I" & lastrow).Select
Selection.PasteSpecial xlPasteValues


Application.CutCopyMode = False
Sheet1.Columns.AutoFit

Application.ScreenUpdating = True

End Sub

Answer 1

This does the same you do, but shorter and more efficient. It will paste the data always into the same rows.

    Sub Wageworks_Import()
Application.ScreenUpdating = False

Dim lrM, lrF, erow As Long
Dim wbk As Workbook
Dim sht, sht2 As Worksheet

Set wbk = Workbooks.Open("J:\Accounting - Copy\Accounting Projects\Wageworks Import\WAGEWORKS IMPORT.xlsx")
Set sht = wbk.Worksheets("index")
Set sht2 = ThisWorkbook.Worksheets("ENTRY")

lrF = sht.Cells(Rows.Count, 7).End(xlUp).Row
lrM = sht2.Range("B:B").Find("*", SearchDirection:=xlPrevious).Row

sht.Range(Cells(10, 7), Cells(lrF, 7)).Copy _
Destination:=sht2.Range("B" & lrM + 1)

sht.Range(Cells(10, 4), Cells(lrF, 4)).Copy _
Destination:=sht2.Range("I" & lrM + 1)

Application.CutCopyMode = False
sht2.Columns.AutoFit

wbk.Close saveChanges:=False
Application.ScreenUpdating = True
End Sub