无法选择包含今天日期的单元

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