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