我有以下代码,它基本上从文件夹中的某些文件复制数据库并粘贴到我的工作簿中。
它应该在开始之前清理所有内容,当我从控制台运行时,它会执行F8并通过它,但是当我单击我已分配宏的按钮时,它不会清除旧基座之前得到新的,然后我得到旧数据,然后在它下面的新数据。
你知道是什么原因引起的吗?
谢谢!
Sub Atualizar_B_Un_Time()
Application.ScreenUpdating = False 'speed up macro execution
Application.EnableEvents = False 'turn off other macros for now
Application.DisplayAlerts = False 'turn off system messages for now
Dim base_5 As Workbook
Dim plan_5 As Worksheet
Dim aux As String
Dim caminho As String
Dim nome_arquivo_5 As String
Dim destino_5 As Worksheet
Dim dia As String
Set destino_5 = ThisWorkbook.Worksheets("B_Un_Time")
caminho = Application.ActiveWorkbook.Path
nome_arquivo_5 = Dir(caminho & "\IC_Reports_AgentUnavailableTime*.xlsx")
destino_5.Range("H2:L" & Cells(Rows.Count, "I").End(xlUp).Row).UnMerge
destino_5.Range("F2:F" & Cells(Rows.Count, "F").End(xlUp).Row).ClearContents
destino_5.Range("H2:L" & Cells(Rows.Count, "I").End(xlUp).Row).ClearContents
Do While nome_arquivo_5 <> ""
aux = caminho & "\" & nome_arquivo_5
Set base_5 = Workbooks.Open(aux, Local:=True)
Set plan_5 = base_5.Sheets(1)
dia = Mid(nome_arquivo_5, InStr(nome_arquivo_5, "-") + 1, 2)
plan_5.Range("A2:E" & plan_5.Cells(Rows.Count, "B").End(xlUp).Row).Copy _
Destination:=destino_5.Range("H" & (destino_5.Cells(Rows.Count, "I").End(xlUp).Row + 1))
destino_5.Range("F" & (destino_5.Cells(Rows.Count, "F").End(xlUp).Row + 1) & ":" & "F" & _
(destino_5.Cells(Rows.Count, "I").End(xlUp).Row)).Value = Format(Now, "mm/") & dia & Format(Now, "/yyyy")
base_5.Close savechanges:=False
nome_arquivo_5 = Dir
Loop
If IsEmpty(destino_5.Range("A" & destino_5.Cells(Rows.Count, "I").End(xlUp).Row)) Then
destino_5.Range("A2:E2").Copy Destination:=destino_5.Range("A" & (destino_5.Cells(Rows.Count, "A").End(xlUp).Row + 1) _
& ":" & "E" & destino_5.Cells(Rows.Count, "I").End(xlUp).Row)
destino_5.Range("G2").Copy Destination:=destino_5.Range("G" & (destino_5.Cells(Rows.Count, "G").End(xlUp).Row + 1) & ":" & _
"G" & destino_5.Cells(Rows.Count, "I").End(xlUp).Row)
ElseIf Not IsEmpty(destino_5.Range("A" & (destino_5.Cells(Rows.Count, "I").End(xlUp).Row + 1))) Then
destino_5.Rows((destino_5.Cells(Rows.Count, "I").End(xlUp).Row + 1) & ":" & destino_5.Cells(Rows.Count, "A") _
.End(xlUp).Row).EntireRow.Delete
End If
destino_5.Cells.Font.Name = "Calibri"
destino_5.Cells.Font.Size = 8
destino_5.Rows.RowHeight = 11.25
Application.DisplayAlerts = True 'turn system alerts back on
Application.EnableEvents = True 'turn other macros back on
Application.ScreenUpdating = True 'refreshes the screen
End Sub
答案 0 :(得分:2)
可能是因为您没有在任何地方添加工作表引用。因此引用了活动表。请尝试修改该部分(注意点):
With destino_5
.Range("H2:L" & .Cells(.Rows.Count, "I").End(xlUp).Row).UnMerge
.Range("F2:F" & .Cells(.Rows.Count, "F").End(xlUp).Row).ClearContents
.Range("H2:L" & .Cells(.Rows.Count, "I").End(xlUp).Row).ClearContents
End With