Angebot zur Güte...
10.06.2016 20:42:19
Michael
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