Code optimieren Daten aus anderer Datei
11.08.2020 12:57:21
Andreas
kann mir jemand sagen und helfen wie ich diesen Code optimieren kann.
In meinem Fall ist es so:
Ich habe eine Masterdatei die ich öffne und von dort aus den Code starte.
Es sollen jetzt die beiden Dateien (1.Datei =Original) "ZNIALL_TPL_0010_05.078.2020.xlsx"
und die (2.Datei =Zieldatei) "Admin_ZNIALL_TPL_0010.xlsx
geöffnet werden.
Aus der Original sollen jetzt die Spalten H, AG, und AM ab Zeile 2 bis End(xlUp) kopiert werden und in die Zieldatei in Tabelle1 ab Spalte "A5" wieder eingefügt werden.
leider kann ich die Dateien nicht hochladen da diese alle über 15MB groß sind
Ich habe dazu folgendes Makro erstellt:
Public Sub Datei_oeffnen2()
Dim WBM As Workbook ' WBM = Masterdatei. In dieser ist der Code (in meinem _
Fall "Admin_Ressourcenplanung.xlsm")
Dim WBAdminZNIALL As Workbook ' WBAdminZNIALL = 1. Geöffnete Datei (in meinem Fall " _
Admin_ZNIALL_TPL_0010.xlsx")
Dim WBOrigZNIALL As Workbook ' WBOrigZNIALL = 2. Geöffnete Datei (in meinem Fall " _
ZNIALL_TPL_0010_+Datum.xlsx")
Dim strPfad1 As String ' Pfad1 = Originaldatei "ZNIALL_TPL_0010_+Datum"
Dim strPfad2 As String ' Pfad2 = Aufbereitung "Admin_ZNIALL_TPL_0010"
Dim loletzteH As Long
Dim loletzteAG As Long
Dim loletzteAM As Long
Dim loletzteB As Long
'Dim Ziel As Range
Set WBM = Workbooks("Admin_PM aktuelle Ressourcenplanung_10.08.2020.xlsm") ' WBM ist jetzt _
deine Datei "Master Start" ("Admin_Ressourcenplanung.xlsm")
strPfad1 = ActiveWorkbook.path & "\" & Worksheets("Benutzer").Range("M12").Text & ".xlsx" ' _
Original"
strPfad2 = ActiveWorkbook.path & "\" & Worksheets("Benutzer").Range("M13").Text & ".xlsb" ' _
Aufbereitung" (zum übernehmen in Ressourcenplanung Tabelle "Erfassung_Bearbeitung")
Set WBOrigZNIALL = Application.Workbooks.Open(strPfad1) ' WBOrigZNIALL = 2. Geöffnete _
Datei (in meinem Fall "ZNIALL_TPL_0010_+Datum.xlsx")
Set WBAdminZNIALL = Application.Workbooks.Open(strPfad2) ' WBAdminZNIALL = 1. Geöffnete _
Datei (in meinem Fall "Admin_ZNIALL_TPL_0010.xlsb")
loletzteH = WBOrigZNIALL.Worksheets("Tabelle1").Cells(Rows.Count, 8).End(xlUp).Row
loletzteAG = WBOrigZNIALL.Worksheets("Tabelle1").Cells(Rows.Count, 33).End(xlUp).Row
loletzteAM = WBOrigZNIALL.Worksheets("Tabelle1").Cells(Rows.Count, 39).End(xlUp).Row
loletzteB = WBM.Worksheets("Erfassung_Bearbeitung").Cells(Rows.Count, 2).End(xlUp).Row
With WBM.Worksheets("Erfassung_Bearbeitung")
'Bereich kopieren
.Range("A5:B" & loletzteB).Copy 'kopiert die Spalte B(Spaltennummer 2)von A5 bis zur _
letzten belegten Zelle in "B"
WBAdminZNIALL.Worksheets("Aufbereitung_ZNIALL").Range("A5").PasteSpecial Paste:= _
xlPasteValues
'.Worksheets("Tabelle2").Range("A1").Activate
End With
Application.CutCopyMode = False 'setzt den Kopierrahmen in ZNIALL_TPL_0010_xxxx. _
xlsx Spalte "AM" zurück
With WBOrigZNIALL.Worksheets("Tabelle1")
'Bereich kopieren
.Range("H2:H" & loletzteH).Copy 'kopiert die Spalte H(Spaltennummer 8)von H2 bis zur _
letzten belegten Zelle
WBAdminZNIALL.Worksheets("Tabelle1").Range("A2").PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False 'setzt den Kopierrahmen in ZNIALL_TPL_0010_xxxx. _
xlsx Spalte "AM" zurück
With WBOrigZNIALL.Worksheets("Tabelle1")
'Bereich kopieren
.Range("AG2:AG" & loletzteAG).Copy 'kopiert die Spalte AG(Spaltennummer 33)von AG2 bis _
_
zur letzten belegten Zelle
WBAdminZNIALL.Worksheets("Tabelle1").Range("B2").PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False 'setzt den Kopierrahmen in ZNIALL_TPL_0010_xxxx. _
xlsx Spalte "AM" zurück
With WBOrigZNIALL.Worksheets("Tabelle1")
'Bereich kopieren
.Range("AM2:AM" & loletzteAM).Copy 'kopiert die Spalte AM(Spaltennummer 39)von AM2 bis _
_
zur letzten belegten Zelle
WBAdminZNIALL.Worksheets("Tabelle1").Range("C2").PasteSpecial Paste:=xlPasteValues
End With
Application.CutCopyMode = False 'setzt den Kopierrahmen in ZNIALL_TPL_0010_xxxx. _
xlsx Spalte "AM" zurück
WBAdminZNIALL.Worksheets("Aufbereitung_ZNIALL").Range("F1").Select
With WBAdminZNIALL.Worksheets("Aufbereitung_ZNIALL")
Range("A5").Select
End With
Application.CutCopyMode = False 'setzt den Kopierrahmen in ZNIALL_TPL_0010_xxxx. _
xlsx Spalte "AM" zurück
WBOrigZNIALL.Close
End Sub
Das Makro funktioniert auch soweit.
Ist halt ein bischen langsam.
und das speichern der dann aufbereiteten Datei "Admin_ZNIALL_TPL_0010.xlsx" dauert dann 20 - 35 min.
Vielleicht kann man das auch ohne dem vorherigen öffnen der Original und Zieldatei machen.
Hintergrund der Vorgehensweise ist das ich in der Zieldatei im Tabellenblatt "Aufbereitung_ZNIALL" Formeln mit SVERWEIS habe (bereit reduziert auf 3 Spalten aber immerhin 248.000 Zeilen) welche das manuelle speichern der Datei anschließen 20-35 min dauern lässt.
Die Original Datei wird übrigens aus SAP jede Woche 1mal gezogen und hat dabei bereits stolze 53MB (250 Spalten und 480.000 Zeilen)
Für Eure Hilfe wäre ich sehr dankbar.
Gruß Andreas