Question

我正在整合我的团队发送的每日报告，该报告名为＆＃34;主文件＆＃34;它将为我的每个团队成员分别提供每张表。我需要在我的团队成员发送的报告中找到包含今天日期的单元格并复制相应的单元格并将其粘贴到＆＃34;主文件＆＃34; 这是代码

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

注意： - 在早期阶段工作正常。在对格式和外观进行少量更改后，还在＆＃34;主文件中添加了所有工作表＆＃34;之后我收到这个错误!!我也是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

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

1 个答案: