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

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