Question

我是vba的新手。但是，我在工作中试图解决一个大问题。我们收到通过通勤税前扣除计划提供的服务付款。这通常是我们必须进入三个系统的大约160多笔付款。我已经建立了一个电子表格，可以在我们输入存款时减少错误。但是，我正在尝试将通勤程序中的付款导入我的电子表格，以减少大约一个小时（或两个）的数据输入。我正在尝试将其导入的电子表格是一个excel表。我正在尝试复制并粘贴两列。我希望“WAGEWORKS IMPORT”电子表格中的列D（帐号＃）仅复制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

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

1 个答案: