Question

我想通过比较当前系统日期将数据从一个工作簿复制到另一个工作簿。

Billings ECCS是我要将数据复制到名为New的其他工作簿的文件，工作表名为Billing Details。

我只想复制那些属于当前系统日期的数据。 Billing ECCS工作簿包含名为Billing List的工作表，其中第一列为Date of Entry。

我想将该日期与系统当前日期进行比较，然后通过查找下一个空行将相应的数据复制到另一个工作表。

Option Explicit
Sub SendToBilling()
Option Explicit
Sub Macro2()
Dim LastRow As Long
Dim eRow As Long
Dim i As Long
Dim wbMaster As Workbook
Set wbMaster = Workbooks.Open("file:///C:\Users\mrisingh\Desktop\Billing.xlsx")
With wbMaster.Worksheets("Billing Sheet")
LastRow = .Range("A" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
If Cells(i, 1) = Date Then
Range(Cells(i, 1), Cells(i, 6)).Select
Selection.Copy  
eRow = Worksheets("Billing Details").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Cells(eRow, 1).Select
ActiveSheet.Paste
End If
Next i
End With    
End Sub

Answer 1

您需要明确哪个工作表是哪个

Sub SendToBilling()

    Dim LastRow As Long
    Dim eRow As Long
    Dim i As Integer

    Dim wbMaster As Workbook
    Set wbMaster = Workbooks.Open("C:\Users\mrisingh\Desktop\Billing ECCS.xlsx")

   Dim SourceSheet as worksheet
   Dim DestinationSheet as worksheet  

   Set Sourcesheet = wbmaster.worksheets("Billing List")
   set destinationsheet = Workbooks("New").worksheets("Billing Details")

'I think I've got these the right way round? Is your workbook really called NEW?


        LastRow = destinationsheet.Range("A" & Rows.Count).End(xlUp).Row
        For i = 2 To LastRow
            If sourcesheet.Cells(i, 1) = Date Then
                 eRow = destinationSheet.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
                sourcesheet.Range(Cells(i, 1), Cells(i, 6)).copy destinationsheet(erow,1)


              End If
        Next i
    End With  
End Sub

在比较输入日期之后将数据从一个工作簿复制到另一个工作簿

1 个答案: