VBA自動填充速度問題

我正在優化我的vba代碼，但直到現在我還沒有成功。有沒有可能看到我的代碼並告訴我如何讓它更快？VBA自動填充速度問題

我有兩個excel文件：其中1個是excel模板，將從中計算報告，另一個是生成器。在附加的代碼中，我知道它很長，你可以找到已經寫好的代碼。我不確定如何進一步優化此代碼，所以您的幫助將有所幫助。

謝謝

的Jeroen

Sub Prepare_Files() 

    Dim TabName As String 

    MacroSheet = "Sheet1" 
    File_Loc = "File Locations" 
    strReportDate = Worksheets(MacroSheet).Range("I23").Value 
    strPrevReportDate = Worksheets(MacroSheet).Range("I26").Value 
    strInvoiceDate = Worksheets(MacroSheet).Range("I29").Value 
    TemplateAUHUHeadyOpen = False 

    EEEEEEEEEJJJ = "A. Oipoip Data - YYYYYY" 
    EEEEEEEEEUHUH = "B. Oipoip Data - XXXXXXXXXX" 
    QQQQQQ_Inv = "C. QQQQQQ Data - Inventory" 
    QQQQQQ_Act = "D. QQQQQQ Data - Active" 
    Prod_Data = "E. PROD Data" 
    Report_Detail = "F. Report Detail" 
    Sales_Summary = "G. Sales Summary" 
    US_Trial_Plans = "P. US Trial Plans" 
    US_Wholesale_Plans = "Q. US Wholesale Plans" 
    CAN_Trial_Plans = "R. CAN Trial Plans" 
    CAN_Wholesale_Plans = "S. CAN Wholesale Plans" 

    JJJ_NA_Data_Locn = Worksheets(File_Loc).Range("B2").Value 
    JJJ_UK_Data_Locn = Worksheets(File_Loc).Range("B3").Value 
    JJJ_EU_Data_Locn = Worksheets(File_Loc).Range("B4").Value 
    UHUH_NA_Data_Locn = Worksheets(File_Loc).Range("B5").Value 
    UHUH_UK_Data_Locn = Worksheets(File_Loc).Range("B6").Value 
    UHUH_EU_Data_Locn = Worksheets(File_Loc).Range("B7").Value 
    QQQQQQ_Act_Data_Locn = Worksheets(File_Loc).Range("B8").Value 
    QQQQQQ_Inv_Data_Locn = Worksheets(File_Loc).Range("B9").Value 
    Prod_Build_Data_Locn = Worksheets(File_Loc).Range("B10").Value 
    TemplateFiles_Locn = Worksheets(File_Loc).Range("B11").Value 
    New_Sales_Report_Locn = Worksheets(File_Loc).Range("B12").Value 
    ZZZ_Invoice_Data_Locn = Worksheets(File_Loc).Range("B13").Value 
    EEEEEEEEEFile_Locn = Worksheets(File_Loc).Range("B14").Value 

    ModelYear1 = Worksheets("Settings").Range("B2").Value 
    ModelYear2 = Worksheets("Settings").Range("B3").Value 
    ModelYear3 = Worksheets("Settings").Range("B4").Value 
    ModelYear4 = Worksheets("Settings").Range("B5").Value 
    ModelYear5 = Worksheets("Settings").Range("B6").Value 

    ReportNum = Worksheets(MacroSheet).Range("I18").Value 

    If ReportNum = 1 Then 
     All_Reports = False 
     All_Reports_1st_No = 1 
     All_Reports_last_No = 1 
     TabName = EEEEEEEEEJJJ 
     JJJ_Data_Locn = JJJ_NA_Data_Locn 
    Else 
     Exit Sub 
    End If 

    For All_Reports_No = All_Reports_1st_No To All_Reports_last_No 

     If All_Reports_No = 1 Then 
      MarketName = "North America" 
      OptOuts_ColNo = OptOuts_ColNo1 
      VistaCountryname = VistaCountryname1 
      SettingsColumnNo = SettingsColumnNo1 
      SheetName_Data_In_Daily_Report = SheetName_Data_In_Daily_Report1 
      JJJ_Vista_File_Locn = JJJ_NA_Data_Locn 
      UHUH_Vista_File_Locn = UHUH_NA_Data_Locn 
     End If 

    Next All_Reports_No 

    JJJ_VistaFile = Dir$(JJJ_Vista_File_Locn & "\YYYYYY TSTSTSTS - " & MarketName & " - " & Format(strReportDate, "dd-mm-yy") & ".xlsx") 
    If Len(JJJ_VistaFile) = 0 Then 
     MsgBox ("The Data file 'YYYYYY TSTSTSTS - " & MarketName & " - " & Format(strReportDate, "dd-mm-yy") & ".xlsx""' is missing") 
     Exit Sub 
    End If 

    UHUH_VistaFile = Dir$(UHUH_Vista_File_Locn & "\YHYHYHYHY TSTSTSTS - " & MarketName & " - " & Format(strReportDate, "dd-mm-yy") & ".xlsx") 
    If Len(UHUH_VistaFile) = 0 Then 
     MsgBox ("The Data file 'YHYHYHYHY TSTSTSTS - " & MarketName & " - " & Format(strReportDate, "dd-mm-yy") & ".xlsx""' is missing") 
     Exit Sub 
    End If 

    OipoipFile = Dir$(EEEEEEEEEFile_Locn & "\ZZZ_reports_" & Format(strReportDate, "yyyy-mm-dd") & ".zip") 
    If Len(OipoipFile) = 0 Then 
     MsgBox ("The Data file 'ZZZ_reports_" & Format(strReportDate, "yyyy-mm-dd") & ".zip""' is missing") 
     Exit Sub 
    End If 

    QQQQQQInvFile = Dir$(QQQQQQ_Inv_Data_Locn & "\QQQQQQ Inventory_" & Format(strReportDate, "yyyymmdd") & "*.xls") 
    If Len(QQQQQQInvFile) = 0 Then 
     MsgBox ("The QQQQQQ Inventory Data file 'QQQQQQ Inventory_" & Format(strReportDate, "yyyymmdd") & "*.xls""' is missing") 
     Exit Sub 
    End If 

    QQQQQQActFile = Dir$(QQQQQQ_Act_Data_Locn & "\QQQQQQ Activated_" & Format(strReportDate, "yyyymmdd") & "*.xls") 
    If Len(QQQQQQActFile) = 0 Then 
     MsgBox ("The QQQQQQ Activated Data file 'QQQQQQ Activated_" & Format(strReportDate, "yyyymmdd") & "*.xls""' is missing") 
     Exit Sub 
    End If 

    ProdBuildFile = Dir$(Prod_Build_Data_Locn & "\Production Build Data IOIOIOIOIOI_PAPAPAPAPAPAPA.xlsx") 
    If Len(ProdBuildFile) = 0 Then 
     MsgBox ("The Data file 'Production Build Data IOIOIOIOIOI_PAPAPAPAPAPAPA.xlsx' is missing") 
     Exit Sub 
    End If 

    TemplateFile = Dir$(TemplateFiles_Locn & "\Sales Report V6 Template.xlsx") 
    If Len(TemplateFile) = 0 Then 
     MsgBox ("The Template file 'Sales Report V6 Template.xlsx' is missing") 
     Exit Sub 
    End If 

    PrevReportFile = Dir$(New_Sales_Report_Locn & "\Sales Report V6 - " & Format(strPrevReportDate, "dd.mm.yyyy") & ".xlsx") 
    If Len(PrevReportFile) = 0 Then 
     MsgBox ("The Previous Report ('Sales Report V6 - " & Format(strPrevReportDate, "dd.mm.yyyy") & ".xlsx') is not found.") 
     Exit Sub 
    End If 

    ZZZInvoiceFile = Dir$(ZZZ_Invoice_Data_Locn & "\ZZZ Invoice - " & Format(strInvoiceDate, "mm.yyyy") & ".xlsx") 
    If Len(ZZZInvoiceFile) = 0 Then 
     MsgBox ("The Previous Report ('ZZZ Invoice - " & Format(strInvoiceDate, "mm.yyyy") & ".xlsx') is not found.") 
     Exit Sub 
    End If 

    FolderPath = New_Sales_Report_Locn & "\" 

    'Copy the YYYYYY Data from the Vista Data file to the Template's EEEEEEEEEJJJ Sheet 

    If ReportNum = 1 Then 
     'Now that all the required files are present, Copy the first YYYYYY Vista Data file to the Template 
     'But first switch off Auto Caluculate in Excel 
     'Application.EnableEvents = False 
     Application.Calculation = xlCalculationManual 

     If All_Reports_No = 1 Then 
      TabName = TabName1 
      MarketName = MarketName1 
     End If 

     'Set the Template to y and clear any exisitng data from the Built Orders tab 
     If TemplateAUHUHeadyOpen = False Then 
      Set wbTemplate = Workbooks.Open(TemplateFiles_Locn & "\" & TemplateFile) 
     ElseIf TemplateAUHUHeadyOpen = True Then 
      Workbooks.Item(TemplateFile).Activate 
     End If 

     'Open the YYYYYY Vista Data File & copy the data 
     Set wbJJJVista = Workbooks.Open(JJJ_Vista_File_Locn & "\" & JJJ_VistaFile) 
     Workbooks.Open(JJJ_Vista_File_Locn & "\" & JJJ_VistaFile).Activate 
     Worksheets("All Built Orders").Select 
     Range("A1").Select 
     Selection.End(xlDown).Select 
     NoOfRows_Data = ActiveCell.Row 

     'Apply Filters 
     ActiveSheet.Range("$A$1:$Y$" & NoOfRows_Data).AutoFilter Field:=1, Criteria1:=Array(""), Operator:=xlFilterValues 
     ActiveSheet.ShowAllData 
     ActiveSheet.Range("$A$1:$Y$" & NoOfRows_Data).AutoFilter Field:=15, Criteria1:=Array(_ 
     ModelYear1, _ 
     ModelYear2, _ 
     ModelYear3, _ 
     ModelYear4, _ 
     ModelYear5), Operator:=xlFilterValues 
     Filtered_Total = Application.WorksheetFunction.Subtotal(103, [A2:A1040000]) 

     Range("A2:Y2").Select 
     Range(Selection, Selection.End(xlDown)).Select 
     Selection.Copy 

     'Go to the Template File & paste the data into the first sheet 
     Workbooks.Item(TemplateFile).Activate 
     Sheets(EEEEEEEEEJJJ).Range("B2").PasteSpecial 
     Application.CutCopyMode = False 
     Selection.End(xlDown).Select 
     NoOfRows_Data = ActiveCell.Row 
     Range("A1").Select 

     'Close the Vista Data File, without saIOIOIOIOIOIg 
     Workbooks.Item(JJJ_VistaFile).Activate 
     ActiveWorkbook.Close SaveChanges:=False 


'******** 
    'Check if the TRTRTRTR Data file exists, in zipped format or the unzipped format 
    RTRTRT = Dir$(EEEEEEEEEFile_Locn & "\ZZZ_report_" & Format(strReportDate, "yyyy-mm-dd") & "_3.csv") 
    If Len(RTRTRT) = 0 Then 
     ZippedRTRTRT = Dir$(EEEEEEEEEFile_Locn & "\ZZZ_reports_" & Format(strReportDate, "yyyy-mm-dd") & ".zip") 
     If Len(ZippedRTRTRT) = 0 Then 
      MsgBox ("The Zipped TRTRTRTR Data File ('ZZZ_reports_" & Format(strReportDate, "yyyy-mm-dd") & ".zip') is not found") 
      Exit Sub 
     Else 
      FolderPath = EEEEEEEEEFile_Locn 
      zFile = "ZZZ_reports_" & Format(strReportDate, "yyyy-mm-dd") & ".zip" 
      UnzipFile FolderPath & "\" & zFile, FolderPath 
      RTRTRT = Dir$(EEEEEEEEEFile_Locn & "\ZZZ_report_" & Format(strReportDate, "yyyy-mm-dd") & "_3.csv") 
      If Len(RTRTRT) = 0 Then 
       MsgBox ("The TRTRTRTR Data File (ZZZ_report_" & Format(strReportDate, "yyyy-mm-dd") & "_3.csv) is not found in the zipped file") 
       Exit Sub 
      Else 

       'Copy the WCData from the TRTRTRTR Data file to the Template's WData tab 
       'Only need to do this once for all the reports 
       Set wbWCData = Workbooks.Open(EEEEEEEEEFile_Locn & "\" & RTRTRT, Format:=4, Delimiter:=",") 
       Workbooks.Open(EEEEEEEEEFile_Locn & "\" & RTRTRT, Format:=4, Delimiter:=",").Activate 
       Range("A2:C2").Select 
       Range(Selection, Selection.End(xlDown)).Select 

       'Cells.Select 
       Selection.Copy 
       Range("A1").Select 

       With wbTemplate 
        If TemplateAUHUHeadyOpen = True Then 
         wbTemplate.Sheets("T. Oipoip PAPAPAPAPAPAPA").Range("A2").PasteSpecial 
        Else 
         Workbooks.Item(TemplateFile).Activate 
         wbTemplate.Sheets("T. Oipoip PAPAPAPAPAPAPA").Range("A2").PasteSpecial 
         Worksheets("T. Oipoip PAPAPAPAPAPAPA").Select 
         Range("C:C").Select 
         Selection.NumberFormat = "0" 
        End If 

        Range("A1").Select 
        Application.CutCopyMode = False 
        TemplateAUHUHeadyOpen = True 
        RTRTRT_Populated = True 

       End With 

       With wbWCData 
        Workbooks.Item(RTRTRT).Close 
       End With 

      End If 
     End If 
    Else 

     RTRTRT = Dir$(EEEEEEEEEFile_Locn & "\ZZZ_report_" & Format(strReportDate, "yyyy-mm-dd") & "_3.csv") 

     'Copy the WCData from the TRTRTRTR Data file to the Template's WData tab 
     'Only need to do this once for all the reports 
     'Set wbWCData = Workbooks.Open(EEEEEEEEEFile_Locn & "\" & RTRTRT, Format:=4, Delimiter:=",") 
     'Workbooks.Open(EEEEEEEEEFile_Locn & "\" & RTRTRT, Format:=4, Delimiter:=",").Activate 

     Sheets("T. Oipoip PAPAPAPAPAPAPA").Select 
     Range("A1").Select 
     ConnectionTxt = "TEXT;" & EEEEEEEEEFile_Locn & "\ZZZ_report_" & Format(strReportDate, "yyyy-mm-dd") & "_3.csv" 
     With ActiveSheet.QueryTables.Add(Connection:=ConnectionTxt, Destination:=Range("$A$1")) 
'   .CommandType = 0 
      .Name = RTRTRT 
      .FieldNames = True 
      .RowNumbers = False 
      .FillAdjacentFormulas = False 
      .PreserveFormatting = True 
      .RefreshOnFileOpen = False 
      .RefreshStyle = xlInsertDeleteCells 
      .SavePassword = False 
      .SaveData = True 
      .AdjustColumnWidth = True 
      .RefreshPeriod = 0 
      .TextFilePromptOnRefresh = False 
      .TextFilePlatform = 850 
      .TextFileStartRow = 2 
      .TextFileParseType = xlDelimited 
      .TextFileTextQualifier = xlTextQualifierDoubleQuote 
      .TextFileConsecutiveDelimiter = False 
      .TextFileTabDelimiter = False 
      .TextFileSemicolonDelimiter = False 
      .TextFileCommaDelimiter = True 
      .TextFileSpaceDelimiter = False 
      .TextFileColumnDataTypes = Array(1, 1, 2) 
      .TextFileTrailingMinusNumbers = True 
      .Refresh BackgroundQuery:=False 
     End With 

     Range("A1").Select 

     Range("A1").Select 
     Application.CutCopyMode = False 
     TemplateAUHUHeadyOpen = True 
     RTRTRT_Populated = True 

    End If 

'******** 
     'Open the YHYHYHYHY Vista Data File & copy the data 
     Set wbUHUHVista = Workbooks.Open(UHUH_Vista_File_Locn & "\" & UHUH_VistaFile) 
     'Workbooks.Open(UHUH_Vista_File_Locn & "\" & UHUH_VistaFile).Activate 
     Worksheets("All Built Orders").Select 
     Range("A1").Select 
     Selection.End(xlDown).Select 
     NoOfRows_Data = ActiveCell.Row 

     'Apply Filters 
     ActiveSheet.Range("$A$1:$Y$" & NoOfRows_Data).AutoFilter Field:=1, Criteria1:=Array(""), Operator:=xlFilterValues 
     ActiveSheet.ShowAllData 
     ActiveSheet.Range("$A$1:$Y$" & NoOfRows_Data).AutoFilter Field:=15, Criteria1:=Array(_ 
     ModelYear1, _ 
     ModelYear2, _ 
     ModelYear3, _ 
     ModelYear4, _ 
     ModelYear5), Operator:=xlFilterValues 
     Filtered_Total = Application.WorksheetFunction.Subtotal(103, [A2:A1040000]) 

     'Range("A2:Y2").Select 
     Range("A2:Y" & NoOfRows_Data).Select 
     Selection.Copy 

     'Go to the Template File & paste the data into the second sheet 
     Workbooks.Item(TemplateFile).Activate 
     Sheets(EEEEEEEEEUHUH).Range("B2").PasteSpecial 
     Application.CutCopyMode = False 
     Worksheets(EEEEEEEEEUHUH).Select 
     Range("A1").Select 
     'Selection.End(xlDown).Select 
     'NoOfRows_Data = ActiveCell.Row 

     'Close the Vista Data File, without saIOIOIOIOIOIg 
     'Workbooks.Open(UHUH_Vista_File_Locn & "\" & UHUH_VistaFile).Activate 
     Workbooks.Item(UHUH_VistaFile).Activate 
     ActiveWorkbook.Close SaveChanges:=False 

'******** 
     'Open the QQQQQQ Inventory Data File & copy the data 
     Set wbJasInv = Workbooks.Open(QQQQQQ_Inv_Data_Locn & "\" & QQQQQQInvFile) 
     Worksheets("Sheet0").Select 
     Range("A2").Select 
     Selection.End(xlDown).Select 
     NoOfRows_Data = ActiveCell.Row 

     Range("A2:B2").Select 
     Range("A2:B" & NoOfRows_Data).Select 
     Selection.Copy 

     'Go to the Template File & paste the data into the third sheet 
     Workbooks.Item(TemplateFile).Activate 
     Sheets(QQQQQQ_Inv).Range("B2").PasteSpecial 
     Application.CutCopyMode = False 

     Workbooks.Item(QQQQQQInvFile).Activate 
     Worksheets("Sheet0").Select 
     Range("M2:N" & NoOfRows_Data).Select 
     Selection.Copy 

     'Go to the Template File & paste the data into the third sheet 
     Workbooks.Item(TemplateFile).Activate 
     Sheets(QQQQQQ_Inv).Range("D2").PasteSpecial 
     Application.CutCopyMode = False 

     Workbooks.Item(QQQQQQInvFile).Activate 
     Worksheets("Sheet0").Select 
     Range("D2:E" & NoOfRows_Data).Select 
     Selection.Copy 

     'Go to the Template File & paste the data into the third sheet 
     Workbooks.Item(TemplateFile).Activate 
     Sheets(QQQQQQ_Inv).Range("F2").PasteSpecial 
     Application.CutCopyMode = False 

     Workbooks.Item(QQQQQQInvFile).Activate 
     Worksheets("Sheet0").Select 
     Range("H2:H" & NoOfRows_Data).Select 
     Selection.Copy 

     'Go to the Template File & paste the data into the third sheet 
     Workbooks.Item(TemplateFile).Activate 
     Sheets(QQQQQQ_Inv).Range("H2").PasteSpecial 
     Application.CutCopyMode = False 

     Workbooks.Item(QQQQQQInvFile).Activate 
     Worksheets("Sheet0").Select 
     Range("J2:K" & NoOfRows_Data).Select 
     Selection.Copy 

     'Go to the Template File & paste the data into the third sheet 
     Workbooks.Item(TemplateFile).Activate 
     Sheets(QQQQQQ_Inv).Range("I2").PasteSpecial 
     Application.CutCopyMode = False 
     Worksheets(QQQQQQ_Inv).Select 
     Range("A1").Select 

     'Close the Vista Data File, without saIOIOIOIOIOIg 
     Workbooks.Open(QQQQQQ_Inv_Data_Locn & "\" & QQQQQQInvFile).Activate 
     ActiveWorkbook.Close SaveChanges:=False 

     'Open the QQQQQQ Activated Data File & copy the data 
     Set wbJasAct = Workbooks.Open(QQQQQQ_Act_Data_Locn & "\" & QQQQQQActFile) 
     Worksheets("Sheet0").Select 
     Range("A2").Select 
     Selection.End(xlDown).Select 
     NoOfRows_Data = ActiveCell.Row 
     Range("A2:A" & NoOfRows_Data).Select 
     Selection.Copy 

     'Go to the Template File & paste the data into the third sheet 
     Workbooks.Item(TemplateFile).Activate 
     Sheets(QQQQQQ_Act).Range("B2").PasteSpecial 
     Application.CutCopyMode = False 

     Workbooks.Item(QQQQQQActFile).Activate 
     Worksheets("Sheet0").Select 
     Range("O2:O" & NoOfRows_Data).Select 
     Selection.Copy 

     'Go to the Template File & paste the data into the third sheet 
     Workbooks.Item(TemplateFile).Activate 
     Sheets(QQQQQQ_Act).Range("C2").PasteSpecial 
     Application.CutCopyMode = False 

     'Set wbJasAct = Workbooks.Open(QQQQQQ_Act_Data_Locn & "\" & QQQQQQActFile) 
     Workbooks.Item(QQQQQQActFile).Activate 
     Worksheets("Sheet0").Select 
     Range("B2:B" & NoOfRows_Data).Select 
     Selection.Copy 

     'Go to the Template File & paste the data into the third sheet 
     Workbooks.Item(TemplateFile).Activate 
     Sheets(QQQQQQ_Act).Range("D2").PasteSpecial 
     Application.CutCopyMode = False 

     Workbooks.Item(QQQQQQActFile).Activate 
     Worksheets("Sheet0").Select 
     Range("M2:N" & NoOfRows_Data).Select 
     Selection.Copy 

     'Go to the Template File & paste the data into the third sheet 
     Workbooks.Item(TemplateFile).Activate 
     Sheets(QQQQQQ_Act).Range("E2").PasteSpecial 
     Application.CutCopyMode = False 

     Workbooks.Item(QQQQQQActFile).Activate 
     Worksheets("Sheet0").Select 
     Range("D2:E" & NoOfRows_Data).Select 
     Selection.Copy 

     'Go to the Template File & paste the data into the third sheet 
     Workbooks.Item(TemplateFile).Activate 
     Sheets(QQQQQQ_Act).Range("G2").PasteSpecial 
     Application.CutCopyMode = False 
     Worksheets(QQQQQQ_Inv).Select 

     Workbooks.Item(QQQQQQActFile).Activate 
     Worksheets("Sheet0").Select 
     Range("H2:H" & NoOfRows_Data).Select 
     Selection.Copy 

     'Go to the Template File & paste the data into the third sheet 
     Workbooks.Item(TemplateFile).Activate 
     Sheets(QQQQQQ_Act).Range("I2").PasteSpecial 
     Application.CutCopyMode = False 
     Worksheets(QQQQQQ_Inv).Select 

     Workbooks.Item(QQQQQQActFile).Activate 
     Worksheets("Sheet0").Select 
     Range("J2:K" & NoOfRows_Data).Select 
     Selection.Copy 

     'Go to the Template File & paste the data into the third sheet 
     Workbooks.Item(TemplateFile).Activate 
     Sheets(QQQQQQ_Act).Range("J2").PasteSpecial 
     Application.CutCopyMode = False 
     Worksheets(QQQQQQ_Act).Select 
     Range("A1").Select 

     'Close the Vista Data File, without saIOIOIOIOIOIg 
     Workbooks.Item(QQQQQQActFile).Activate 
     ActiveWorkbook.Close SaveChanges:=False 

     'Open the Production Build Data File & copy the data 
     Set wbJasAct = Workbooks.Open(Prod_Build_Data_Locn & "\" & ProdBuildFile) 
     Worksheets("PROD_IOIOIOIOIOI_PAPAPAPAPAPAPA").Select 
     Range("A2:D2").Select 
     Range(Selection, Selection.End(xlDown)).Select 
     Selection.Copy 

     'Go to the Template File & paste the data into the third sheet 
     Workbooks.Item(TemplateFile).Activate 
     Sheets(Prod_Data).Range("C2").PasteSpecial 
     Application.CutCopyMode = False 
     Worksheets(Prod_Data).Select 
     Range("A1").Select 

     'Close the Production Build Data File, without saIOIOIOIOIOIg 
     Workbooks.Open(Prod_Build_Data_Locn & "\" & ProdBuildFile).Activate 
     ActiveWorkbook.Close SaveChanges:=False 

     'Open the ZZZ Invoice Data File & copy the data set 1 
     Set wbJasAct = Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile) 
     'Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile).Activate 
     Worksheets("US - Other Charges (Trial Fee)").Select 
     Range("A7:I7").Select 
     Range(Selection, Selection.End(xlDown)).Select 
     Selection.Copy 

     'Go to the Template File & paste the data into the data trial summary sheet 
     Workbooks.Item(TemplateFile).Activate 
     Sheets(US_Trial_Plans).Range("A2").PasteSpecial 
     Application.CutCopyMode = False 
     Worksheets(US_Trial_Plans).Select 
     Range("A1").Select 

     'Close the Invoice File, without saIOIOIOIOIOIg 
     Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile).Activate 
     ActiveWorkbook.Close SaveChanges:=False 

     'Open the ZZZ Invoice Data File & copy the data set 2 
     Set wbJasAct = Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile) 
     'Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile).Activate 
     Worksheets("US - January Rate Plan Detail ").Select 
     Range("A10:H10").Select 
     Range(Selection, Selection.End(xlDown)).Select 
     Selection.Copy 

     'Go to the Template File & paste the data into the data wholesale summary sheet 
     Workbooks.Item(TemplateFile).Activate 
     Sheets(US_Wholesale_Plans).Range("A2").PasteSpecial 
     Application.CutCopyMode = False 
     Worksheets(US_Wholesale_Plans).Select 
     Range("A1").Select 

     'Close the Invoice File, without saIOIOIOIOIOIg 
     Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile).Activate 
     ActiveWorkbook.Close SaveChanges:=False 

     'Open the ZZZ Invoice Data File & copy the data set 3 
     Set wbJasAct = Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile) 
     Worksheets("CAN Other Charges (Trial Fee) ").Select 
     Range("A7:I7").Select 
     Range(Selection, Selection.End(xlDown)).Select 
     Selection.Copy

的代碼的其餘部分將在此查詢的評論。

來源

2016-09-09 Joe_ft

向下延伸在模板文件中的所有公式（這些公式的大多是指數+匹配式的）

複製公式的值作爲加快事後打開報表

這是重複勞動。取決於你有多少公式，有一件事可以加速這一點LOT將使用VBA來計算值。目前，您正在使用VBA複製和粘貼公式，等待公式計算，複製公式，然後粘貼爲值。只需在VBA中進行整個計算並將最終結果放入電子表格中即可快速。您可以使用Application.WorksheetFunction將在電子表格中工作的任何函數放入VBA中。

我也看到你正在打開文件，然後關閉它們而不保存更改。嘗試用ReadOnly:=True打開它們。它可以造成很大的速度差異。

後來補充：

取決於你正在尋找了一下，但是，如果你把我的意見和VBA內完成所有的計算，你可能會發現，Find和Offset是比MATCH和INDEX更高效。純屬巧合，我發佈了一個使用Find和Offset今天早些時候的例子：https://stackoverflow.com/a/39410878/2475052

來源

2016-09-09 12:05:06

感謝您的建議，我將完全修改我的代碼:) –

這它的代碼休息...

'Go to the Template File & paste the data into the data trial summary sheet 
      Workbooks.Item(TemplateFile).Activate 
      Sheets(CAN_Trial_Plans).Range("A2").PasteSpecial 
      Application.CutCopyMode = False 
      Worksheets(CAN_Trial_Plans).Select 
      Range("A1").Select 

     'Close the Invoice File, without saIOIOIOIOIOIg 
     Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile).Activate 
     ActiveWorkbook.Close SaveChanges:=False 

     'Open the ZZZ Invoice Data File & copy the data set 4 
     Set wbJasAct = Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile) 
     Worksheets("CAN January Rate Plan Detail").Select 
     Range("A8:N8").Select 
     Range(Selection, Selection.End(xlDown)).Select 
     Selection.Copy 

     'Go to the Template File & paste the data into the data wholesale summary sheet 
     Workbooks.Item(TemplateFile).Activate 
     Sheets(CAN_Wholesale_Plans).Range("A2").PasteSpecial 
     Application.CutCopyMode = False 
     Worksheets(CAN_Wholesale_Plans).Select 
     Range("A1").Select 

     'Close the Invoice File, without saIOIOIOIOIOIg 
     Workbooks.Open(ZZZ_Invoice_Data_Locn & "\" & ZZZInvoiceFile).Activate 
     ActiveWorkbook.Close SaveChanges:=False 

     'Extend down all the formulae in the Template file 
     Workbooks.Item(TemplateFile).Activate 
     Worksheets(EEEEEEEEEJJJ).Select 
     Range("B2").Select 
     Selection.End(xlDown).Select 
     NoOfRows_Data = ActiveCell.Row 
     NoOfRows1 = "A2:A" & NoOfRows_Data 
     Range("A2").Select 
     Selection.AutoFill Destination:=Range(NoOfRows1) 

     NoOfRows1 = "AA2:AA" & NoOfRows_Data 
     Range("AA2:AA2").Select 
     Selection.AutoFill Destination:=Range(NoOfRows1) 
     Range("A1").Select 

     Worksheets(EEEEEEEEEUHUH).Select 
     Range("B2").Select 
     Selection.End(xlDown).Select 
     NoOfRows_Data = ActiveCell.Row 
     NoOfRows1 = "A2:A" & NoOfRows_Data 
     Range("A2").Select 
     Selection.AutoFill Destination:=Range(NoOfRows1) 
     Range("A1").Select 

     NoOfRows1 = "AA2:AA" & NoOfRows_Data 
     Range("AA2:AA2").Select 
     Selection.AutoFill Destination:=Range(NoOfRows1) 
     Range("A1").Select 

     Worksheets(QQQQQQ_Inv).Select 
     Range("B2").Select 
     Selection.End(xlDown).Select 
     NoOfRows_Data = ActiveCell.Row 
     NoOfRows1 = "A2:A" & NoOfRows_Data 
     Range("A2").Select 
     Selection.AutoFill Destination:=Range(NoOfRows1) 
     Range("L2").Value = Format(strReportDate, "dd-mmm-yyyy") 
     Range("A1").Select 

     Worksheets(QQQQQQ_Act).Select 
     Range("B2").Select 
     Selection.End(xlDown).Select 
     NoOfRows_Data = ActiveCell.Row 
     NoOfRows1 = "A2:A" & NoOfRows_Data 
     Range("A2").Select 
     Selection.AutoFill Destination:=Range(NoOfRows1) 
     Range("W2").Value = Format(strReportDate, "dd-mmm-yyyy") 
     Range("X2").Value = Format(Now(), "dd-mmm-yyyy") 
     Range("A1").Select 

     NoOfRows1 = "L2:P" & NoOfRows_Data 
     Range("L2:P2").Select 
     Selection.AutoFill Destination:=Range(NoOfRows1) 
     Range("A1").Select 

     NoOfRows1 = "Q2:Q" & NoOfRows_Data 
     Range("Q2").Select 
     Selection.AutoFill Destination:=Range(NoOfRows1) 
     Range("A1").Select 

     NoOfRows1 = "R2:V" & NoOfRows_Data 
     Range("R2:V2").Select 
     Selection.AutoFill Destination:=Range(NoOfRows1) 
     Range("A1").Select 

     Worksheets(Prod_Data).Select 
     Range("C2").Select 
     Selection.End(xlDown).Select 
     NoOfRows_Data = ActiveCell.Row 
     NoOfRows1 = "A2:B" & NoOfRows_Data 
     Range("A2:B2").Select 
     Selection.AutoFill Destination:=Range(NoOfRows1) 
     Range("N2").Value = Format(strReportDate, "dd-mmm-yyyy") 
     Range("A1").Select 

     NoOfRows1 = "G2:J" & NoOfRows_Data 
     Range("G2:J2").Select 
     Selection.AutoFill Destination:=Range(NoOfRows1) 
     Range("A1").Select 

     NoOfRows1 = "K2:K" & NoOfRows_Data 
     Range("K2:K2").Select 
     Selection.AutoFill Destination:=Range(NoOfRows1) 
     Range("A1").Select 

     NoOfRows1 = "L2:L" & NoOfRows_Data 
     Range("L2:L2").Select 
     Selection.AutoFill Destination:=Range(NoOfRows1) 
     Range("A1").Select 

     'Report Detail 
     Worksheets(Report_Detail).Select 
     Range("A3").Select 
     NoOfRows1 = "A3:AB" & NoOfRows_Data 
     Range("A3:AB3").Select 
     Selection.AutoFill Destination:=Range(NoOfRows1) 

     NoOfRows1 = "AC3:AC" & NoOfRows_Data 
     Range("AC3").Select 
     Selection.AutoFill Destination:=Range(NoOfRows1) 
     Range("A1").Select 

     NoOfRows1 = "AE3:AL" & NoOfRows_Data 
     Range("AE3:AL3").Select 
     Selection.AutoFill Destination:=Range(NoOfRows1) 
     Range("A1").Select 

     'Now switch on the Auto Caluculate in Excel 
    Application.EnableEvents = True 
    Application.Calculation = xlCalculationAutomatic 

    Worksheets(EEEEEEEEEJJJ).Select 
    Range("B2").Select 

    Sheets(Sales_Summary).Select 

    Range("K16").Select 
    ActiveSheet.PivotTables("PivotTable4").PivotCache.Refresh 
    Range("K4").Select 
    ActiveSheet.PivotTables("PivotTable3").PivotCache.Refresh 
    Range("A4").Select 
    ActiveSheet.PivotTables("PivotTable2").PivotCache.Refresh 
    Range("A16").Select 
    ActiveSheet.PivotTables("PivotTable1").PivotCache.Refresh 

    Application.EnableEvents = False 
    Application.Calculation = xlCalculationManual 

    'Replace all the formulae with actual values to speed up opening the report afterwards 
    Workbooks.Item(TemplateFile).Activate 
    Worksheets(EEEEEEEEEJJJ).Select 
    Range("A2").Select 
    Selection.End(xlDown).Select 
    NoOfRows_Data = ActiveCell.Row 
    Range("A2:A" & NoOfRows_Data).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
    Application.CutCopyMode = False 
    Range("A1").Select 

    'Workbooks.Item(TemplateFile).Activate 
    Worksheets(EEEEEEEEEUHUH).Select 
    Range("A2:A" & NoOfRows_Data).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
    Application.CutCopyMode = False 
    Range("A1").Select 

    'Workbooks.Item(TemplateFile).Activate 
    Worksheets(QQQQQQ_Inv).Select 
    Range("A2:A" & NoOfRows_Data).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
    Sheets(QQQQQQ_Inv).Range("A2").PasteSpecial 
    Application.CutCopyMode = False 
    Range("A1").Select 

    'Workbooks.Item(TemplateFile).Activate 
    Worksheets(QQQQQQ_Act).Select 
    Range("A2:A" & NoOfRows_Data).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
    Application.CutCopyMode = False 
    Range("A1").Select 

    'Workbooks.Item(TemplateFile).Activate 
    Worksheets(QQQQQQ_Act).Select 
    Range("L2:V" & NoOfRows_Data).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
    Application.CutCopyMode = False 
    Range("A1").Select 

    'Workbooks.Item(TemplateFile).Activate 
    Worksheets(Prod_Data).Select 
    Range("A2:B" & NoOfRows_Data).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
    Application.CutCopyMode = False 
    Range("A1").Select 

    'Workbooks.Item(TemplateFile).Activate 
    Worksheets(Prod_Data).Select 
    Range("G2:L" & NoOfRows_Data).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
    Application.CutCopyMode = False 
    Range("A1").Select 

    'Workbooks.Item(TemplateFile).Activate 
    Worksheets(Report_Detail).Select 
    Range("A3:AL" & NoOfRows_Data).Select 
    Selection.Copy 
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 
    Application.CutCopyMode = False 
    Range("A1").Select 

    Application.EnableEvents = True 
    Application.Calculation = xlCalculationAutomatic 

    'Save the Template As the Activation Report file 
    ActiveWorkbook.SaveAs Filename:=(New_Sales_Report_Locn & "\Sales Report V6 - " & Format(strReportDate, "dd.mm.yyyy") & ".xlsx") 
    ActiveWorkbook.Close SaveChanges:=True 
End If 


MsgBox ("The Daily Report(s) generation is now complete.") 

End Sub 

Sub UnzipFile(ByVal sZipFile As String, ByVal sDestFolder As String) 

    Dim objApp As Object 
    Dim objArchive As Object 
    Dim objDest As Object 
    Dim vDestFolder As Variant 
    Dim vZipFile As Variant 

    Set objApp = CreateObject("Shell.Application") 

    vZipFile = sZipFile 
    vDestFolder = sDestFolder 

    If Dir$(sDestFolder, vbDirectory) = "" Then MkDir sDestFolder 

    objApp.Namespace(vDestFolder).CopyHere objApp.Namespace(vZipFile).Items 

End Sub

來源

2016-09-09 10:21:48

這是很多代碼:)。你能告訴我你想要達到的目標嗎？不要以爲我想閱讀所有的代碼來了解其背後的目的 – Zac

對不起，所有的代碼:)！我將簡要介紹一下我想實現的目標。步驟 1.導入10個文件到模板文件 2.複製數據的數據特定表格 3.向下延伸在模板文件中的所有公式（這些公式的大多是指數+匹配式的） 4。將公式的值複製爲值，以加速打開報告 5.將模板文件另存爲新報告這有幫助嗎？ –

沒有人知道如何添加此代碼，使其只是一個只讀的電子表格打開？

'Open the YYYYYY Vista Data File & copy the data 
     Set wbJJJVista = Workbooks.Open(JJJ_Vista_File_Locn & "\" & JJJ_VistaFile) 
     Workbooks.Open(JJJ_Vista_File_Locn & "\" & JJJ_VistaFile).Activate 
     Worksheets("All Built Orders").Select 
     Range("A1").Select 
     Selection.End(xlDown).Select 
     NoOfRows_Data = ActiveCell.Row

來源

2016-09-09 13:36:18

VBA自動填充速度問題

回答

相關問題