mehrere Sheets in neue Datei

Hallo liebes Forum,
ich bräuchte mal wieder eure Unterstützung. Ich habe ein realtiv umfangreiches Problem und versuche nun nach und nach die Probleme zu lösen.
Könntet ihr mir vllt sagen, wie ich bei dem folgenden kleinen Problem weiter komme?
Ich habe eine Excel-Datei, bei der ich nach einem Fragebogen ausleiten möchte. Dafür möchte ich zunächst alle Tabellenblätter in eine neue Datei kopieren, welche dann sortiert wird. Bisher ist es mir nur gelungen ein Tabellenblatt in die neue Datei zu bekommen, wie mache ich das mit mehreren? Bei mir kommt dann immer ein Fehler mit Listentrennzeichen oder ) einfügen. Habe da schon sämtliches probiert. Wäre über eine Hilfe sehr dankbar. Wie ginge es bspw mit Blatt 1 und Blatt 3?

Private Sub CheckBox41_Click()
Application.ScreenUpdating = False
MsgBox "Eine neue Datei wird angelegt. Bestätigen mit OK !"
'Tabelle kopieren in neues Blatt
Application.ScreenUpdating = False
Sheets("Blatt2").Select
Sheets("Blatt2").Copy
Sheets("Blatt2").Name = neu & Format(Now, "DD.MM.YYYY")
Absicherung 'nach ra sortieren
Anzeige.Hide
End Sub

Zweites Problem liegt bei der Sortierung. Ich möchte, dass die neue Datei in dem Blatt2 sortiert wird, aber nur dort und nicht in der alten Datei. In dem Fall wird nach der Spalte D sortiert, das soll sich nach einer Auswahl über ein Formular richten. Folgenden Code habe ich dazu. Ich weiß nur nicht, wie ich den in die neue Datei bekomme. Vielleicht kann mir da ja auch jemand helfen. Danke.

Private Sub CheckBox41_Click()
ThisWorkbook.Worksheets("Blatt2").Activate
Range("A20:DG566" & ActiveSheet.UsedRange.Rows.Count).Select
Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
Range("D2").Select
End Sub

Christien,
...obwohl Du Dich auf meine letzte Antwort in Deinem vorigen Thread nicht mehr gemeldet hast - ich wollte helfen, aber wenn Du Dich nicht mehr meldest interessiert es auch nicht.
Hier Dein "Problem-Code" von mir überarbeitet mit Kommentaren - LIES DIE BITTE GENAU!

Private Sub CheckBox41_Click()
'Blatt 1 - 3 DIESER Mappe (Mappe aus der das Makro aufgerufen wird)
'in eine neue Mappe kopieren. In der neuen Mappe Blatt 2 sortieren
'Variablendeklarationen
Dim WbQ As Workbook 'Quell-Mappe
Dim WbZ As Workbook 'Ziel-Mappe
Dim Ws As Worksheet 'Tabellenblatt als Objekt (s.u.)
Dim WsZ As Worksheet 'Ziel-Tabellenblatt (s.u.)
Dim i As Long 'Tabellenblatt über Index ansprechen (s.u.)
Dim Chk As Variant 'Prüf-Variable (Msgbox)
Application.ScreenUpdating = False
'Userabfrage, Klick auf Abbruch steigt aus Makro aus...
Chk = MsgBox("Eine neue Datei wird angelegt. OK?", vbOKCancel, _
"Bitte bestätigen...")
If Chk = vbCancel Then Exit Sub
Set WbQ = ThisWorkbook 'Diese Mappe wird zur Quell-Mappe
'Bei Klick auf Okay geht's ab hier weiter...
Set WbZ = Workbooks.Add 'Eine neue Mappe hinzufügen = Ziel-Mappe
'In der Quell-Mappe
With WbQ
'Blätter 1 bis 3, gem. Reihenfolge in der Mappe,
'kopieren...
For i = 1 To 3 'anpassen
'Das kopierte Blatt wird in der Zielmappe jew. ans Ende kopiert
.Worksheets(i).Copy After:=WbZ.Worksheets(WbZ.Worksheets.Count)
Next i
End With
'    '---- Alternativ: bestimmte Blätter (nach Blattnamen) kopieren
'    With WbQ
'        'Alle Blätter in Quell-Mappe durchgehen
'        For Each Ws In .Worksheets
'            'jeweiligen Blattnamen prüfen...
'            Select Case Ws.Name
'                Case Is = "Blatt1", "Blatt2", "Blatt3"
'                    'Das jew. Blatt in der Zielmappe ans Ende kopieren
'                    Ws.Copy After:=WbZ.Worksheets(WbZ.Worksheets.Count)
'                Case Else
'                    ' Hier könnte etwas mit Blättern passieren, die anders
'                    'heißen als Blatt1, Blatt2 oder Blatt3
'            End Select
'        Next Ws
'    End With
'    '---- Alternativ ----
'In der Zielmappe
With WbZ
'Mit dem Tabellenblatt "Blatt2"
Set WsZ = .Worksheets("Blatt2") 'anpassen
With WsZ
'Blatt2 umbenennen
'Wie die Variable neu definiert ist, hast Du nicht verraten
'Wenn aber im Blattnamen "neu" als String stehen soll, muss
'es so eingepflegt werden...
.Name = "neu" & Format(Now, "DD.MM.YYYY")
'Ich habe keine Ahnung worauf sich diese Aufrufe beziehen,
'hab sie jetzt aber mal auskommentiert drinnen gelassen
'Absicherung 'nach ra sortieren
'Anzeige.Hide
'Ab hier Blatt2 in der Zielmappe sortieren
With .Sort
.SortFields.Clear
'Welche Spalte ist das Sortier-Kriterium
'anpassen
'aktuell: C2:Cx (letzte gefüllte Zelle in C)
'B2:Bx wäre bspw.: Range("B2:B" & WsZ.Cells(WsZ.Rows.Count, 2).End(xlUp).Row)
'--> Beachte die geänderte Spaltenzahl nach (WsZ.Rows.Count, !)
.SortFields.Add Key:=WsZ.Range("C2:C" & WsZ.Cells(WsZ.Rows.Count, 3).End(xlUp). _
Row), _
SortOn:=xlSortOnValues, Order:=xlAscending
'Welcher Bereich wird sortiert
'anpassen
'aktuell: A1:Ex (letzte gefüllte Zelle in E)
'Anpassen nach obigem Muster
.SetRange WsZ.Range("A1:E" & WsZ.Cells(WsZ.Rows.Count, 5).End(xlUp).Row)
'Gibt's eine Überschrift in dem Bereich (die dann nicht mitsortiert wird)
'.Header = xlNo ' Nein
.Header = xlYes ' Ja
.Apply 'Sortierung anwenden
End With
'.Activate 'Optional das Ziel-Blatt aktivieren
End With
End With
'Aufräumen nach Durchlauf
Set WbQ = Nothing
Set WbZ = Nothing
'Set Ws = Nothing 'nur erforderlich, wenn oben For Each Ws... genutzt wird, sonst raus!
Set WsZ = Nothing
Application.ScreenUpdating = True
End Sub

Das Problem mit Deinem Faden ist nach wie vor, dass Du entweder gar keine konkreten Infos gibst, oder Deine Code-Versuche ohne Kontext postest.
Aber ich glaube ich habe soweit halbwegs verstanden was Du willst, ich denke mit den Kommentaren solltest Du den o.a. Code auch anpassen können!
Schönes Wochenende und lg
Michael

Forumthread: mehrere Sheets in neue Datei

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

mehrere Sheets in neue Datei

Forumthread: mehrere Sheets in neue Datei

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread