VBA - 从已关闭的工作簿中复制数据的最佳方法

Question

我是巴西一家工业公司的实习生,而且我正在使用excel.几天前我刚刚开始和VBA一起玩,我很开心它可以为我做很多事!

我没有强大的编程背景,所以我基本上都在学习.代码工作正常,从开始到结束只需不到15秒.我不打扰时间,但如果可以改进那就太好了.

我的主要目标是保持代码简单有效.我将在接下来的几个月内离开公司,我希望它很容易保持和使用.我所要求的是一种更好的方式来编写我的代码,以便其他人可以更容易理解,如果可能的话(当然是!)花更少的时间.

我的代码删除了当前工作簿中的4张内容,然后从其他4个已关闭的工作簿中复制更新的数据.然后关闭一切.:)数据是关于日常生产的,他们的名字是葡萄牙语,抱歉.

Sub CopiarBase()

'
' Atalho do teclado: Ctrl+q
'


    ' Variables
    Dim MyCurrentWB As Workbook
    Dim BMalharia As Worksheet
    Dim BBeneficiamento As Worksheet
    Dim BEmbalagem As Worksheet
    Dim BDikla As Worksheet

    Set MyCurrentWB = ThisWorkbook
    Set BMalharia = MyCurrentWB.Worksheets("B-Malharia")
    Set BBeneficiamento = MyCurrentWB.Worksheets("B-Beneficiamento")
    Set BEmbalagem = MyCurrentWB.Worksheets("B-Embalagem")
    Set BDikla = MyCurrentWB.Worksheets("B-Dikla")

    'Clean all the cells - Workbook 1


    Dim Malharia_rng As Range
    Set Malharia_rng = BMalharia.Range("A2:CN" & BMalharia.Cells(Rows.Count, 1).End(xlUp).Row)
    Malharia_rng.ClearContents

    Dim Ben_rng As Range
    Set Ben_rng = BBeneficiamento.Range("A2:CY" & BBeneficiamento.Cells(Rows.Count, 1).End(xlUp).Row)
    Ben_rng.ClearContents

    Dim Emb_rng As Range
    Set Emb_rng = BEmbalagem.Range("A2:CT" & BEmbalagem.Cells(Rows.Count, 1).End(xlUp).Row)
    Emb_rng.ClearContents

    Dim Dikla_rng As Range
    Set Dikla_rng = BDikla.Range("A2:AV" & BDikla.Cells(Rows.Count, 1).End(xlUp).Row)
    Dikla_rng.ClearContents


    'Copy from Malharia Workbook

    Workbooks.Open "C:\Users\marco.henrique\Desktop\Bases\Malharia Base.xls"

    LastRowMB = Workbooks("Malharia Base.xls").Worksheets("Malharia Base").Cells(Rows.Count, 1).End(xlUp).Row
    Dim Malha_base As Range
    Set Malha_base = Workbooks("Malharia Base.xls").Worksheets("Malharia Base").Range("A2:CN" & LastRowMB)

    MyCurrentWB.Worksheets("B-Malharia").Range("A2:CN" & LastRowMB).Value = Malha_base.Value
    Workbooks("Malharia Base.xls").Close

    'Copy from Beneficiamento Workbook

    Workbooks.Open "C:\Users\marco.henrique\Desktop\Bases\Beneficiamento Base.xls"

    LastRowBB = Workbooks("Beneficiamento Base.xls").Worksheets("Beneficiamento Base").Cells(Rows.Count, 1).End(xlUp).Row
    Dim Ben_base As Range
    Set Ben_base = Workbooks("Beneficiamento Base.xls").Worksheets("Beneficiamento Base").Range("A2:CY" & LastRowBB)

    MyCurrentWB.Worksheets("B-Beneficiamento").Range("A2:CY" & LastRowBB).Value = Ben_base.Value
    Workbooks("Beneficiamento Base.xls").Close

    'Copy from Embalagem Workbook

    Workbooks.Open "C:\Users\marco.henrique\Desktop\Bases\Embalagem Base.xls"

    LastRowEB = Workbooks("Embalagem Base.xls").Worksheets("Embalagem Base").Cells(Rows.Count, 1).End(xlUp).Row
    Dim Emb_base As Range
    Set Emb_base = Workbooks("Embalagem Base.xls").Worksheets("Embalagem Base").Range("A2:CT" & LastRowEB)

    MyCurrentWB.Worksheets("B-Embalagem").Range("A2:CT" & LastRowEB).Value = Emb_base.Value
    Workbooks("Embalagem Base.xls").Close

    'Copy from Dikla Workbook

    Workbooks.Open "C:\Users\marco.henrique\Desktop\Bases\Diklatex Base.xls"

    LastRowDB = Workbooks("Diklatex Base.xls").Worksheets("Diklatex Base").Cells(Rows.Count, 1).End(xlUp).Row
    Dim Dikla_base As Range
    Set Dikla_base = Workbooks("Diklatex Base.xls").Worksheets("Diklatex Base").Range("A2:AV" & LastRowDB)

    MyCurrentWB.Worksheets("B-Dikla").Range("A2:AV" & LastRowDB).Value = Dikla_base.Value
    Workbooks("Diklatex Base.xls").Close

End Sub

如果我不够清楚,我很抱歉,当然英语不是我的母语.对我的代码或整个想法的任何疑问都可以随意提问.

在此先感谢任何帮助人员!

Answer 1

我不确定您会腾出多少时间，但我建议在宏运行时禁用屏幕刷新，方法是添加

Application.ScreenUpdating = False

在子的开头（显然与 = True结尾相同的行）