Makro dauert recht lange

Hallo zusammen
Ich hatte letztens schon einmal gepostet (siehe Link) jedoch keine Lösung meines Problems bekommen.
https://www.herber.de/forum/archiv/1204to1208/t1204448.htm
Ich habe eine Masterdatei, von wo aus ich per Schaltfläche Daten aus 8 verschlossenen Arbeitsmappen einlese (Den Code habe ich auch aus diesem Forum entnommen). Das funktioniert soweit auch ganz gut, jedoch dauert die Ausführung des Makros über 10 min, da ich aus den 8 Arbeitsmappen insgesamt 30 x 312 Zellen abfrage. Also es wird Zelle für Zelle abgefragt.
Der Bereich der Quelldatei ist immer gleich dem Bereich der Zieldatei. Also A1 geht nach A1. Betroffen sind nur zusammenhängende Bereiche, also A1:F1 nach A1:F1 und K1:Z1 nach K1:Z1
Bei meinem letzten Posting bekam ich den Hinweis, die Sache mit FormulaArray zu lösen, dass würde die Zeit erheblich reduzieren. Dafür reichen aber meine Kenntnisse nicht aus.
Villeicht kann mir ja jemand auf die Sprünge helfen.
Die hochgeladene Datei habe ich aus Übersichtsgründen zumindest vom Bereich her gekappt.
https://www.herber.de/bbs/user/73931.xlsm
Danke im Voraus für eure Mühen
Gruß Frank

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Ja, schau mal GetMoreSpeed.

Function Mach was()
Call GetmoreSpeed (True)
'Dein Maincode
'MainCode Ende
Call GetmoreSpeed (False)
End 

Function
Gruß Andi
Was das Teil macht, ist im Code erleutert.  Der Rest ist trivial.

Sub GetMoreSpeed(bYesNo As Boolean)
'//Ein- bzw. Ausschalten von Excel-Aktionen
'//Bildschirmaktualisierung
Application.ScreenUpdating = Not (bYesNo)
'//Excel-Aktion-Methoden
Application.EnableEvents = Not (bYesNo)
'//Zellen- /Formelberechnung
Application.Calculation = IIf(bYesNo, xlCalculationManual, xlCalculationAutomatic)
End Sub

Sub sammeln() 'Voraussetzung; 'Die Pfade und Namen der auszulesenden Arbeitsmappen 'stehen in der Tabelle "Dateiliste" in der Materarbeitsmappe 'Hier erstellt das Makro die neuen Tabellenblätter Dim wb As Workbook Dim sh, shListe As Worksheet Dim f As Long Set wb = ThisWorkbook Set sh = wb.Sheets(1) Set shListe = wb.Sheets("Dateiliste") For f = 2 To 9 wb.Sheets.Add After:=Worksheets(Worksheets.Count) Workbooks.Open shListe.Cells(f, 1) Union(Sheets(1).Range("A1:F1"), Range("K1:Z1")). _ Copy Destination:=wb.Sheets(wb.Sheets.Count).Range("A1") ActiveWorkbook.Close savechanges = False Next End Sub

Beliebteste Forumthreads (12 Monate)

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread