mehrere Sheets in neue Datei

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

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

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

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

https://www.herber.de/bbs/user/106183.xlsm
Ich habe hier Teile meiner Excel hochgeladen, wo auch die relevanten VBA Codes für folgende Probleme drin sind. Ich hoffe, dass mein Problem so deutlicher wird.
1. Also Michael, ich hab deinen Code angepasst, aber der funktioniert in diesem Konstrukt so leider nicht, ich habe beide Varianten ausprobiert. Ich habe sie auch in einer anderen Datei probiert, da gingen sie aber!! In dieser Datei kommt immer der Laufzeitfehler 9. Ich vermute das liegt bei mir an den vielen Zellbezügen? Ich habe auch Dropdwon-Listen in fast jeder Spalte. (Also pro Spalte habe ich verschiedene Dropdown Fkt, mal über 3 Zeilen gezogen, mal über 5, mal gar keine Dropdown.) Ist in dem Sheet reale Absicherung immer unter vorformulierte Bemerkung. Kann es daran liegen? Werden bei der Sortierung die Dropwon-Listen auch mit sortiert, oder verschiebt sich dann alles?
2. Zudem ist mir aufgefallen, dass ich auch alle VBA Codes in der neuen Datei benötige, geht das, also kann man einen Code programmieren, mit dem alle Codes aus der Datei in eine neue Datei übernommen werden?
3. Dann findet ihr unter Modul 6 einen Versuch eine Maske für ein Diagramm zu erstellen. Diese Möglichkeit soll auf jeden Fall in der zweiten Datei enthalten sein, daher benötige ich die Codes dort auf jeden Fall...Ich hatte vor, dass wenn ich im Sheet reale Absicherung unter "Titel Kriterien" über die Filterfunktion etwas auswähle, dass zu diesem Thema ein Diagramm erstellt wird. Dazu sollte alle "Bewertungen" , die jeweils von 1 bis 4 gehen, von den jeweiligen Personen (plus dazugehöriges Geschlecht und Perzentil) kopiert werden und in die Maske eingefügt werden, am besten automatisch. Und beim Klick auf "Diagramm anzeigen" sollte automatisch ein gestapeltes Diagramm angezeigt werden, das auf der x-Achse in "gut", "eher gut", "eher schlecht" und "schlecht" aufgeteilt ist, wie in dem Beispiel gezeigt. Ich hoffe ihr könnt mir helfen. Danke!!!!

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

mehrere Sheets in neue Datei

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

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread