VBA Autofill Geschwindigkeit Probleme

Question

Ich arbeite an der Optimierung meines VBA-Code, aber bis jetzt ist es mir noch nicht gelungen. Wäre es möglich, dass Sie meinen Code anschauen und mir sagen können, wie ich es schneller machen kann?

Ich habe zwei Excel-Dateien: 1 von ihnen ist die Excel-Vorlage, aus der der Bericht berechnet wird und die andere 1 ist der Generator. Im angehängten Code, und ich weiß, dass es ziemlich lang ist, können Sie den Code finden, der geschrieben wurde. Ich bin mir nicht sicher, wie ich diesen Code weiter optimieren könnte, so dass jede Hilfe von Ihrer Seite hilfreich wäre.

Danke,

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 

Der Rest des Codes in den Kommentar dieser Abfrage wird.

Answer 1

3. Erweitern Sie sich alle Formeln in der Vorlagendatei (diese Formel ist meist Index + Match-Formel)
4. Copy ist die Formel als Werte den Bericht anschließend

Dies ist eine Doppelarbeit zu beschleunigen, zu öffnen. Abhängig davon, wie viele Formeln Sie haben, könnte eine Sache, die dies beschleunigen könnte, VBA sein, um die Werte zu berechnen. Im Moment verwenden Sie VBA, um Formeln zu kopieren und einzufügen, warten auf die Berechnung der Formeln, kopieren die Formeln und fügen sie dann als Werte ein. Die gesamte Berechnung in VBA durchzuführen und das Endergebnis in die Tabelle zu schreiben, sollte viel schneller sein. Sie können Application.WorksheetFunction verwenden, um jede Funktion, die in einer Kalkulationstabelle funktioniert, in Ihre VBA zu stellen.

Ich sehe auch, dass Sie Dateien öffnen und dann schließen, ohne Änderungen zu speichern. Versuchen Sie, sie mit ReadOnly:=True zu öffnen. Es kann einen großen Geschwindigkeitsunterschied ausmachen. später

---

Hinzugefügt:

abhängig, was Sie suchen, aber, wenn Sie meinen Rat tun nehmen und innerhalb der VBA alle Berechnung tun, könnten Sie auch feststellen, dass Find und Offset sind effizienter als MATCH und INDEX. Per Zufall habe ich heute ein Beispiel für die Verwendung von Find und Offset früher heute geschrieben: https://stackoverflow.com/a/39410878/2475052

Answer 2

Dieses es den Rest des Codes ...

'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 

Answer 3

weiß jemand, wie man diesen Code hinzufügen, um es eine readonly Tabelle öffnen zu lassen?

'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