Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1528to1532
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Makro mit Autofilter + speichern unter in Schleife

Makro mit Autofilter + speichern unter in Schleife
19.12.2016 16:11:20
Frank
Hallo zusammen,
ich habe folgendes Makro für eine Togglebox:
Private Sub ToggleButton4_Click()
Call Blatt_entsperren
If CBool(ToggleButton4.Value) Then  'es gibt nur Wahr oder Falsch, daher keine weitere  _
Bedingung nötig. Wahr = Ausführung, Falsch = Else
ToggleButton4.BackColor = &H8000000F
ToggleButton4.Caption = "alle Einträge anzeigen"
Workbooks("Schulungsplan 2.0.xlsm").Activate
Worksheets("Ausbildungskatalog").Activate
Comboboxen1.Show
Else
ToggleButton4.BackColor = &H8000000F
ToggleButton4.Caption = "Zielgruppe/Mitarbeiter wählen"
ActiveSheet.ListObjects("Tabelle2").Range.AutoFilter Field:=29
ActiveWorkbook.Worksheets("Ausbildungskatalog").Range("E1").ClearContents
Range("B1").Select
Call Blatt_sperren
End If
End Sub

Damit wird der folgende Code ausgeführt:

Option Explicit
Private Sub CommandButton1_Click()
Call Blatt_entsperren
'*** Unnötige Spalten ausblenden
Application.Run "'Schulungsplan 2.0.xlsm'!Tabelle2.ToggleButton3_auf_falsch"
'*** Zeilenhöhe anpassen auf 30
Application.Run "'Schulungsplan 2.0.xlsm'!Tabelle2.ToggleButton2_auf_falsch"
'*** Wert aus Combobox in Tabele übernehmen und filtern
ActiveWorkbook.Worksheets("Ausbildungskatalog").ListObjects("Tabelle2").Range.AutoFilter  _
Field:=29, Criteria1:= _
"=*" & ComboBox1.Value & "*", Operator:=xlAnd
'*** Tabelle nach Datum aufsteigend sortieren
ActiveWorkbook.Worksheets("Ausbildungskatalog").ListObjects("Tabelle2"). _
Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Ausbildungskatalog").ListObjects("Tabelle2"). _
Sort.SortFields.Add Key:=Range("Tabelle2[[#All],[am]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
'*** Wert aus Combobox in Zelle E1 übernehme
ActiveWorkbook.Worksheets("Ausbildungskatalog").Range("E1").Value = ComboBox1.Value
'*** Formular schließen und Zelle B1 anwählen
Unload Me
ActiveWorkbook.Worksheets("Ausbildungskatalog").Range("B1").Select
Call Blatt_sperren
End Sub
Private Sub CommandButton2_Click()
'*** Formular ohne Änderung schließen
Unload Me
'*** ToggleButton4 auf falsch zurückstellen
Application.Run "'Schulungsplan 2.0.xlsm'!Tabelle2.ToggleButton4_auf_falsch"
End Sub
Private Sub UserForm_Initialize()
'*** Formular starten und Werte aus RowSource in Liste einlesen
ComboBox1.RowSource = "Zuordnung_FV!A1:A150"
ComboBox1.Text = "bitte Zielgruppe auswählen" 'Text für die Startanzeige
End Sub

Kurz gesagt wird damit aus einer Namensliste per Dropdown eine Name ausgewählt und in ein Arbeitsblatt "Ausbildungskatalog" in den Autofilter gesetzt. Es stehen dann in einer Liste nur die Einträge des jeweiligen Mitarbeiters.
Nun habe ich folgendes Problem. Ich möchte für 90 Mitarbeiter die Liste der Namen nach und nach durchgehen. Jeder Mitarbeiter soll aufgerufen werden, die Liste für ihn unter seinem Namen gespeichert werden und dann soll der nächste Mitarbeiter aufgerufen werden. Das müsste doch mit einer Schleife gehen. Ich weiß nur leider nicht wie.
Wäre toll, wenn mir jemand helfen kann.
Ach ja, hier noch eine Info:
Die Mitarbeiternahmen stehen auf dem Blatt Zuordnung_FV in den Zellen A38:A128.
Gruß
Frank

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro mit Autofilter + speichern unter in Schleife
21.12.2016 12:56:14
fcs
Hallo Frank,
hier mal das grobe Gerüst eines Makros (ungetestet!), um je Name ein gefiltertes Blatt in einer neuen Datei anzulegen.
LG
Franz
Sub Kursplan_Alle()
Dim Zelle_Name As Range, strName As String
Dim wksNeu As Worksheet
Dim wkbNeu As Workbook
Dim wkbSchulung As Workbook
Set wkbSchulung = ActiveWorkbook
Me.Hide 'Userform ausblenden
wkbSchulung.Worksheets("Ausbildungskatalog").Activate
For Each Zelle_Name In wkbSchulung.Worksheets("Zuordnung_FV").Range("A38:A128").Cells
If Zelle_Name.Text  "" Then
strName = Zelle_Name.Text
' hier dann der Code zum Filtern per Autofilter
Call Blatt_entsperren
'*** Unnötige Spalten ausblenden
Application.Run "'Schulungsplan 2.0.xlsm'!Tabelle2.ToggleButton3_auf_falsch"
'*** Zeilenhöhe anpassen auf 30
Application.Run "'Schulungsplan 2.0.xlsm'!Tabelle2.ToggleButton2_auf_falsch"
'*** Wert aus Combobox in Tabele übernehmen und filtern
wkbSchulung.Worksheets("Ausbildungskatalog").ListObjects("Tabelle2").Range. _
AutoFilter _
Field:=29, Criteria1:= _
"=*" & strName & "*", Operator:=xlAnd
'*** Tabelle nach Datum aufsteigend sortieren
wkbSchulung.Worksheets("Ausbildungskatalog").ListObjects("Tabelle2"). _
Sort.SortFields.Clear
wkbSchulung.Worksheets("Ausbildungskatalog").ListObjects("Tabelle2"). _
Sort.SortFields.Add Key:=Range("Tabelle2[[#All],[am]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
'*** Wert aus Combobox in Zelle E1 übernehme
wkbSchulung.Worksheets("Ausbildungskatalog").Range("E1").Value = strName
'*** Formular schließen und Zelle B1 anwählen
wkbSchulung.Worksheets("Ausbildungskatalog").Range("B1").Select
Call Blatt_sperren
'Blatt kopieren und speichern
'Blatt in neue Datei kopieren
wkbSchulung.Worksheets("Ausbildungskatalog").Copy
Set wkbNeu = ActiveWorkbook
Set wksNeu = wkbNeu.Sheets(1)
'Formeln durch Werte ersetzen - falls erforderlich
With wksNeu
.UsedRange.Copy
.UsedRange.PasteSpecial xlPasteValues
End With
Application.DisplayAlerts = False
wkbNeu.SaveAs Filename:=wkbSchulung.Path & "\" _
& strName & Format(Date, "-YYYY-MM-DD") & ".xlsx", FileFormat:=51 '51 = xlsx-Format
wkbNeu.Close savechanges:=False
Application.DisplayAlerts = True
Set wksNeu = Nothing
Set wkbNeu = Nothing
End If
Next Zelle_Name
'Userform entladen
Unload Me
End Sub

Anzeige
AW: Makro mit Autofilter + speichern unter in Schleife
21.12.2016 14:56:13
Frank
Hallo Franz,
besten Dank für Deine Hilfe. Leider läuft die Lösung bei mir nicht. Zuerst lief ME in einen Fehler, danach gab es Probleme mit dem Blattschutz. Es wurde eine neue Arbeitsmapppe angelegt, die Daten darin sind aber leider nicht vollständig und sie besteht nur aus einem Blatt.
Ich habe aber gestern Abend selbst noch ein bischen getüftelt und bin *stolz* zu einer Lösung gekommen. Dabei bekomme ich die Berichte als PDF ausgegeben, zum Verteilen an die Mitarbeiter reicht das auch vollkommen aus. Was hältst Du davon:
Sub Alle_EA_Pläne_speichern()
Dim Name As String
Dim Zähler As Integer
Dim Pfad As String
Dim msg As String
Dim ans As Integer
'*** Sicherheitsabfrage
msg = "Sie starten die automatische Speicherung der "
msg = msg & "Seminarpläne. Dieser Vorgang kann einige Minuten dauern."
msg = msg & vbNewLine
msg = msg & vbNewLine
msg = msg & "Möchten Sie den Vorgang Fortsetzen?"
ans = MsgBox(msg, vbYesNo)
Select Case ans
Case vbNo
Exit Sub
Case vbYes
End Select
'*** Bildschirmaktualisierung ausschalten
Application.ScreenUpdating = False
'*** Blattschutz aufheben
Call Blatt_entsperren
'*** Unnötige Spalten ausblenden
Application.Run "Tabelle2.ToggleButton3_auf_falsch"
'*** Zeilenhöhe anpassen auf 30
Application.Run "Tabelle2.ToggleButton2_auf_falsch"
'*** Ordner zum Speichern der Berichte auswählen
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = "C:\"
.Title = "Ordnerauswahl"
.ButtonName = "Auswahl..."
.InitialView = msoFileDialogViewList
If .Show = -1 Then
Pfad = .SelectedItems(1)
If Right(Pfad, 1)  "\" Then Pfad = Pfad & "\"
Else
Pfad = ""
End If
End With
If Pfad = "" Then
MsgBox ("Kein Ordner gewählt!")
Exit Sub
End If
'*** Schleife starten, um für jeden genannten Eintrag in der Liste Zuordnung_FV eine eigenen Ü _
bersicht als PDF zu speichern.
For x = 2 To Zeilenanzahl
'*** (nächsten) Namen aus der Liste Zuordnung_FV auslesen
Worksheets("Zuordnung_FV").Activate
Name = Range("A" & x).Value
'*** Namen in den Autofilter im Ausbildungskatalog einsetzen
Worksheets("Ausbildungskatalog").Activate
ActiveWorkbook.Worksheets("Ausbildungskatalog").ListObjects("Tabelle2").Range. _
AutoFilter Field:=30, Criteria1:= _
"=*" & Name & "*", Operator:=xlAnd
'*** Wert aus Namensübersicht in Zelle E1 übernehmen
ActiveWorkbook.Worksheets("Ausbildungskatalog").Range("E1").Value = "Auswahl : " & Name
'*** vorhandene Sortierung löschen
ActiveWorkbook.Worksheets("Ausbildungskatalog").ListObjects("Tabelle2"). _
Sort.SortFields.Clear
'*** Tabelle nach Datum aufsteigend sortieren
ActiveWorkbook.Worksheets("Ausbildungskatalog").ListObjects("Tabelle2"). _
Sort.SortFields.Add Key:=Range("Tabelle2[[#All],[am]]"), SortOn:= _
xlSortOnValues, Order:=xlAscending, DataOption:=xlSortTextAsNumbers
'*** Bei Fehler mit dem nächsten Datensatz weitermachen
On Error Resume Next
'*** Übersicht als PDF speichern
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Pfad & Name & ".pdf", Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False
Next x
'*** Autofilter im Ausbildungskatalog nach Durchlauf löschen
Worksheets("Ausbildungskatalog").Activate
ActiveSheet.ListObjects("Tabelle2").Range.AutoFilter Field:=30
'*** Zelle E1 wieder leeren
Range("E1").ClearContents
'*** Zelle B1 zur besseren Orientierung nach Durchlauf aktivieren
ActiveWorkbook.Worksheets("Ausbildungskatalog").Range("B1").Select
'*** Blattschutz wiederherstellen
Call Blatt_sperren
'*** Bildschirmaktualisierung einschalten
Application.ScreenUpdating = True
End Sub
Bis jetzt lief das auch ohne Fehler durch. Mal sehen, ob sich das auch weiterhin bewährt.
Dir schöne Feiertage und besinnliche Weihnachten.
Gruß
Frank
Anzeige
AW: Makro mit Autofilter + speichern unter in Schleife
21.12.2016 16:24:31
fcs
Hallo Frank,
die Variante alsPDF sollte ohne Probleme laufen.
In meinem Vorschlag war das Anlegen einer neuen Excel-Arbeitsmappe je Name mit nur dem einen Blatt schon geplant.
Allerdings hatte ich vergessen, dass der Blattschutz aktiv ist und beim Ersetzen von Formeln durch Werte kam dann wahrscheinlich der Fehler.
Hier wäre noch die Variante möglich, nach jedem Filtern/Sortieren für einen Namen die gesamte Mappe per SaveCopyAs für den einzelnen Namen zu speichern.
LG
Franz

314 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige