运行宏在调试模式下正常工作,但是当我单击按钮运行时不能

时间:2018-04-20 17:17:55

标签: excel vba excel-vba

我有以下代码,它基本上从文件夹中的某些文件复制数据库并粘贴到我的工作簿中。

它应该在开始之前清理所有内容,当我从控制台运行时,它会执行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

1 个答案:

答案 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