無法選擇包含今天日期的單元格

Question

我將團隊發送的每日報告合並到一個名為“主文件”的文件中，它將為我的每個團隊成員分別制作每張工作表。 我需要在我的團隊成員發送的報告中找到包含今天日期的單元格，然后復制相應的單元格並將其粘貼到“主文件”中，這是代碼

Sub Copy_data()
    Sheets("Daily Report").Select
    Range("A7").Select
    Dim mydate As Date
    mydate = Range("B1")
    For i = 1 To 4 'this is sample actually i have 38 sheets
    Dim filename As Variant
    ActiveCell.Offset(1, 0).Select
    filename = ActiveCell.Value
    Workbooks.Open "C:\Users\test\Desktop\AP\" & filename
    Application.Wait (Now + TimeValue("0:00:02"))
    Sheets("Dashboard").Select
    Cells.Find(What:=mydate, After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate ' this is where i get an error as "object variable or with block variable not set"

    ActiveCell.Offset(0, 2).Select
    Dim currentcell As Integer
    currentcell = ActiveCell.Row
    Range(Selection, Cells(currentcell, 10)).Copy
    Windows("Agent Performance.xls").Activate
    Dim sheetname As String
    sheetname = ActiveCell.Offset(0, 1).Value
    Sheets(sheetname).Select

    'Here again i have to find the cell with today's date and paste the data which i copied    
    Next i

End Sub

注意：-在早期階段，它運行良好。 在格式和外觀上進行了幾處更改后，還在“主文件”中添加了所有工作表，然后出現了這個錯誤！ 我也是VBA的初學者，請原諒我的任何缺陷。

Answer 1

我竭盡全力修復您的代碼，避免使用所有.Select / .Activate ，這可能會引起一些麻煩。

在您的OP中，我看不到要粘貼的位置，因此在最后進行了有根據的猜測，並進行了注明。

使用F8逐步執行此操作以確保其正常工作，然后您可以一次跟隨它一行。

Sub Copy_data()
Dim newWB As Workbook, currentWB As Workbook, agentWB As Workbook
Dim dailyWS As Worksheet, dashWS As Worksheet
Dim i       As Long
Dim foundCell As Range
Dim currentcell As Integer
Dim destSheetname As String


Set currentWB = ThisWorkbook
Set dailyWS = currentWB.Sheets("Daily Report")
Dim mydate  As Date
mydate = dailyWS.Range("B1")
For i = 1 To 4               'this is sample actually i have 38 sheets
    Dim filename As Variant
    filename = dailyWS.Range("A7").Offset(1, 0).Value
    Set newWB = Workbooks.Open("C:\Users\test\Desktop\AP\" & filename)
    Application.Wait (Now + TimeValue("0:00:02"))
    Set dashWS = newWB.Sheets("Dashboard")
    Set foundCell = dashWS.Cells.Find(What:=mydate, After:=ActiveCell, LookIn:=xlFormulas, _
                                      LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                                      MatchCase:=False, SearchFormat:=False)

    currentcell = foundCell.Offset(0, 2).Row
    dashWS.Range(foundCell.Offset(0, 2), dashWS.Cells(currentcell, 10)).Copy
    Set agentWB = Workbooks("Agent Performance.xls")
    destSheetname = agentWB.Sheets(ActiveSheet).Range("A1").Offset(0, 1).Value 'Do you know the activesheet name? If so use it here instead.
    agentWB.Sheets(destSheetname).Activate
    ''' Is this where you want to paste??
    agentWB.Sheets(destSheetname).Range("A1").Paste

    'Here again i have to find the cell with today's date and paste the data which i copied
Next i

End Sub