Excel VBA-將兩列從一個工作簿復制並粘貼到另一個工作簿

Question

我是vba的新手。 但是，我有一個大問題，我們正在努力解決。 我們通過通勤者稅前扣除計划收取服務費用。 通常，我們必須輸入三個系統才能支付大約160多種付款。 我建立了一個電子表格，可以減少我們輸入存款時的錯誤。 但是，我試圖將通勤者程序中的付款導入到電子表格中，以減少大約一小時（或兩個小時）的數據輸入。 我要導入到的電子表格是一個excel表。 我正在嘗試復制和粘貼兩列。 我希望“ WAGEWORKS IMPORT”電子表格中的D列（帳戶編號）僅復制G列中使用的單元格並將它們粘貼到B列中的活動工作簿中，並復制D列中的使用過的單元格（$ Amt並將其粘貼到第I列中的活動工作簿中（活動工作簿為ThisWorkbook-簿記員將使用命令按鈕，在完善代碼后，我將在稍后分配該命令按鈕），我只能獲取它來復制列中的單元格G並將它們復制到B列中的單元格中。D列中的單元格將粘貼到I列中，但是它們是在表的末尾進行的，該表位於我需要它們的下方600多個行。 我需要相應的付款以匹配同一行中的帳號。 我的代碼如下。 有人可以幫忙嗎？

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

這樣做與您相同，但更短，更有效。 它將數據始終粘貼到相同的行中。

    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