Hallo,
ich habe da eine (hoffentlich)klene Frage:
Ich abe ein Makro im Internet gefunden das bisher meinen Wünschen entspricht. Das Makro kopiert ganze Tabellenblätter aus mehreren Dateien in eine Zusammenfassung. Dazu fragt es wo die Dateien gespeichert sind, und gibt den neuen Tabellenblätter in der neuen Datei den Dateinamen als Sheetnamen. Funktionier talles tadellos.
Nun bräuchte ich eine Änderung die mir aus einem Tabellnblatt (erstes Tabellenblatt in allen Dateien genant "Wochenansicht") nur die komplette Spalten L und M kopiert. Habe schon mit allen Änderungen die ich gefunden habe versuct das Makro umzuschreiben (Column; Range, selection,...) bekomme dan aber ur Fehlermeldungen.
Leere Zeilen sollen mitkopiert werden.
Kann mir jemand helfen?
Zur Info: Die Dateien sind eine AUflistung von Messwerten je Kalenderwoche im 4 Sekundentakt. Das bedeutet dass die Datein zimlich groß sind (je Woche 151200 Werte)
Hier das Makro
Sub kopie()
Dim oTargetBook As Object
Dim oSourceBook As Object
Dim sPfad As String
Dim sDatei As String
Dim oFileDialog As FileDialog
Application.ScreenUpdating = False 'Das "Flackern" ausstellen
Application.DisplayAlerts = False 'Keine Fehlermeldungen anzeigen
'Schritt 1: Arbeitsmappe festlegen, in die die neuen Sheets eingefügt werden...
Set oTargetBook = ActiveWorkbook
'Wichtiger Hinweis: Die Arbeitsblätter dürfen nicht vorhanden sein!
'Alternativer Umbau: Löschen evtl. bereits vorhandener Arbeitsblätter
'Schritt 2: Schleife über alle Excel Dateien in einem Verzeichnis
Set oFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
With oFileDialog
.Title = "Importverzeichnis wählen..."
.ButtonName = "Import"
If .Show = -1 Then sPfad = .SelectedItems(1)
End With
If Trim(sPfad) = "" Then Exit Sub
If Right(sPfad, 1) <> "\" Then sPfad = sPfad & "\"
sDatei = Dir(CStr(sPfad & "*.xl*")) 'Alle Excel Dateien
Do While sDatei <> ""
'Schritt 3: öffnen der Datei und Datenübertragung
Set oSourceBook = Workbooks.Open(sPfad & sDatei, False, True) 'nur lesend öffnen
'Es wird immer das erste Tabellenblatt Sheets(1) kopiert!
oSourceBook.Sheets(3).Copy after:=oTargetBook.Sheets(oTargetBook.Sheets.Count)
ActiveSheet.UsedRange.Cells = ActiveSheet.UsedRange.Cells.Value
'Es wird versucht den Dateinamen als Arbeitsblattnamen zu setzen.
'Ist dieser bereits vorhanden wird der Fehler abgefangen und das neue Blatt
'bekommt keinen anderen Namen und behält den typischen Namen Tabelle x
On Error Resume Next
'Arbeitsblattname wird der Dateiname
oTargetBook.Sheets(oTargetBook.Sheets.Count).Name = sDatei
'Wenn ein Fehler aufgetreten ist, wird dieser resettet
If Err.Number <> 0 Then
Err.Number = 0
Err.Clear
End If
On Error GoTo 0
'Schritt 4: Datei wieder zu machen und nächste Schleifenrunde
oSourceBook.Close False 'nicht speichern
'Nächste Datei
sDatei = Dir()
Loop
Application.ScreenUpdating = True 'Das Bildschirm-Aktualisieren wieder einschalten
Application.DisplayAlerts = True 'Fehlermeldungen wieder anzeigen
'Kleine finale Fertig-Meldung
MsgBox "Fertig!", vbInformation + vbOKOnly, "Hinweis!"
'Variablen aufräumen
Set oTargetBook = Nothing
Set oSourceBook = Nothing
End Sub