Excel VBA - 從一個工作簿複製並粘貼兩列到另一個

Question

我是vba新手。但是，我有一個很大的問題，我們試圖在工作中解決。我們收到通過通勤稅前抵扣計劃提供的服務款項。這通常是我們必須進入三個系統的約160+付款。我建立了一個電子表格，可以在我們輸入存款時減少錯誤。但是，我試圖從通勤程序中導入付款到我的電子表格中，以切斷大約一小時（或兩次）的數據輸入。我試圖導入它的電子表格是一個Excel表格。我試圖複製並粘貼兩列。我希望「WAGEWORKS IMPORT」電子表格中的D列（Account＃'s）僅複製G列中已用過的單元格，並將它們粘貼到B列中的活動工作簿中，並將已用過的單元格複製到D列（$ Amt ）並將它們粘貼到第一列中的活動工作簿中（活動工作簿是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