Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 22:08:10
Auflisten in Spalte VBA
23.04.2024 21:33:46
Nur farbige/nicht farbige Zellen markieren
23.04.2024 21:29:56
Bestimmte Zellen auf andere Arbeitsblätter kopieren
23.04.2024 17:41:19
Link erstellen mit Formel oder VBA?
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1892to1896
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
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1892to1896
1892to1896
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Schleife statt diverser Einzelmakros?

Schleife statt diverser Einzelmakros?
21.07.2022 08:07:09
tursiops
Hallo!
Ich führe eine Fortbildungsdatei für alle Mitarbeiter.
Immer wenn neue Mitarbeiter hinzukommen, baue ich ein neues Makro wie das unten aufgeführte.
Inzwischen bin ich bei 170 Mitarbeitern und Makros. Leider kann ausser mir hier niemand diese Anpassung vornehmen.
ich würde daher das Makro gern flexibler und übersichtlicher gestalten.
Das Ziel wäre es auf ein einziges Makro zu reduzieren, aber hier eine Schleife laufen zu lassen, die den Code unten solange ausführt, wie Verweise auf Registerkarten in Zeile 1 ab Spalte P (Registerblatt Plan) stehen.
Sobald die Zelle leer ist, sollte die Schleife enden.
Leider sind meine VBA-Kennnisse hierfür auch nicht ausreichend.
Hat jemand eine Idee, wie ich das angehen könnte?
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

Sub Uebertragung_MA60()
'Application.ScreenUpdating = False
'filtert die Fortbildungen, die der Mitarbeiter besucht hat
Sheets("Plan").Select
ActiveSheet.Unprotect Password:="1234"
ActiveSheet.Range("MA_FOBI_Anfang:MA_FOBI_Ende").AutoFilter Field:=1, Criteria1:=""
Range("AOK_FOBI_Anfang:AOK_FOBI_Ende").Select
Selection.Copy
'kopiert die erfolgten Fortbildungen in das Registerblatt des Mitarbeiters
Sheets("MA.60").Select. '
'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Schleife statt diverser Einzelmakros?
21.07.2022 10:09:43
MCO
Hallo Tursiops!
Ohne Arbeitsmappe war das zwar nicht zu testen, aber ich hoffe, du kannst wenigstens den Ansatz schon für Dich adaptieren....

Sub Uebertragung_MA60()
'Application.ScreenUpdating = False
Dim MA As String
With Sheets("Plan")
.Unprotect Password:="1234"
For spalte = .Range("P").Column To .UsedRange.Columns.Count
.Select 'kann entfallen
'filtert die Fortbildungen, die der Mitarbeiter besucht hat
.Range("MA_FOBI_Anfang:MA_FOBI_Ende").AutoFilter Field:=1, Criteria1:=""
.Range("AOK_FOBI_Anfang:AOK_FOBI_Ende").Copy
MA = .Cells(1, spalte)
'kopiert die erfolgten Fortbildungen in das Registerblatt des Mitarbeiters
With Sheets(MA)
.Select  'kann entfallen '
Gruß, MCO
Anzeige
AW: Schleife statt diverser Einzelmakros?
21.07.2022 11:13:20
tursiops
Hallo!
Zunächst vielen Dank für die Mühe!
Der Code erzeugt zunächst den Fehler Next ohne For
Zudem ist glaube ich die Variable spalte nicht definiert. Hier ist bestimmt Integer der korrekte Variablentyp?
Fehlermeldung nur fast korrekt...
21.07.2022 12:30:11
MCO
Hallo!
Tatsächlich fehlt nicht das "Next", sonder davor ein "end with"
korrekt sieht es so aus:

Sub Uebertragung_MA60()
'Application.ScreenUpdating = False
Dim MA As String
Dim spalte As Long
With Sheets("Plan")
.Unprotect Password:="1234"
For spalte = .Range("P").Column To .UsedRange.Columns.Count
.Select 'kann entfallen
'filtert die Fortbildungen, die der Mitarbeiter besucht hat
.Range("MA_FOBI_Anfang:MA_FOBI_Ende").AutoFilter Field:=1, Criteria1:=""
.Range("AOK_FOBI_Anfang:AOK_FOBI_Ende").Copy
MA = .Cells(1, spalte)
'kopiert die erfolgten Fortbildungen in das Registerblatt des Mitarbeiters
With Sheets(MA)
.Select  'kann entfallen '
Gruß, MCO
Anzeige
AW: Fehlermeldung nur fast korrekt...
21.07.2022 15:07:57
tursiops
Hallo und nochmals danke!
Jetzt sehe ich es auch, 2x With...
Aktuell läuft der Code an dieser Zeile:
For spalte = .Range("P").Column To .UsedRange.Columns.Count
in einen Laufzeitfehler 1004
Nach meinem Verständnis (was nichts heißt) müsste die Zeile so lauten:
For spalte = Range("P1").Column To ActiveSheet.UsedRange.Columns.Count
Zunächst läuft die Schleife damit auch an. Mit zwei Problemen:
1. Der Filter wir Dimmer in der ersten Spalte (P) gesetzt, müsste ja aber auch je eine Spalte weiter nach rechts laufen.
2. immer bei MA 36 (Spalte AZ) stoppt die Schleife mit Laufzeitfehler 1004 - Die AutoFilter-Methode des Range-Objektes konnte nicht ausgeführt werden.
Anzeige
AW: Fehlermeldung nur fast korrekt...
21.07.2022 21:08:57
tursiops
Hallo nochmals!
Ich bin selbst ein kleines Stückchen weiter gekommen, würde mich dennoch nochmal über Hilfe freuen.
Die Fragen sind direkt im Code hinterlegt.
So ist der aktuelle Stand:

Sub Uebertragung_alleMA()
'Application.ScreenUpdating = False
Dim MA As String
Dim spalte As Long
With Sheets("Plan")
.Unprotect Password:="1234"
For spalte = Range("P1").Column To ActiveSheet.UsedRange.Columns.Count '>> 1. Für das Setzen und löschen von Filtern müsste die Nr. der Spalte ab P1 ermittlelt werden. Aktuell ziehe ich einfach 15 ab, dass ist jedoch nicht ideal
' >>> 2. Die Schleife stoppt noch nicht korrekt. Könnte man statt To ActiveSheet.UsedRange auch irgendwie den definierten Zellnamen "letzterMA" nutzen?
.Select 'kann entfallen
'filtert die Fortbildungen, die der Mitarbeiter besucht hat
.Range("MA_FOBI_Anfang:MA_FOBI_Ende").AutoFilter Field:=spalte-15, Criteria1:="" ' >> 3. Bei Mitarbeitern, die gar keine Fortbildung registriert haben, werden derzeit ungefiltert alle Fortbildungen kopiert. Wie könnte man diese Fälle berücksichtigen?
.Range("AOK_FOBI_Anfang:AOK_FOBI_Ende").Copy
MA = .Cells(1, spalte)
'kopiert die erfolgten Fortbildungen in das Registerblatt des Mitarbeiters
With Sheets(MA)
.Select  'kann entfallen
freizeile = .Cells(Rows.Count, 3).End(xlUp).Row + 1
.Cells(freizeile, 2).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
End With
'setzt die Filtereinstellungen zurueck
.Select 'kann entfallen
.Range("MA_FOBI_Anfang:MA_FOBI_Ende").AutoFilter Field:=spalte
'faerbt den Mitarbeiter in der Kopfzeile unter "Plan!" gruen ein
With .Range(.Cells(1, spalte), .Cells(9, spalte))
.Select 'kann entfallen
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End With
Next spalte
.Protect Password:="1234"
End With
'Application.ScreenUpdating = True
End Sub
Ich danke im Voraus und für die bisherige Unterstützung!
Anzeige
etwas schwierig ohne Tabelle...
22.07.2022 07:23:15
MCO
Moin!
Ohne es zu testen, ist es immer schwierig Fehler auszumerzen oder überhaupt den Sinn des Codes zu beurteilen.
Daher auch hier: Nur auf Zuruf und ungetestet:
Tausche aus:

For spalte = Range("P1").Column To Range("letzterMA").Column
Wie soll ich das wissen?!? 

.Range("MA_FOBI_Anfang:MA_FOBI_Ende").AutoFilter Field:=spalte - 15, Criteria1:="" '
Da musst du dann mit mit Einzelschritten durch die einzelnen Spalten gehen und schauen, welche Variablengrößen ungültig sind.
Gruß, MCO
Anzeige
AW: etwas schwierig ohne Tabelle...
22.07.2022 09:33:47
tursiops
Hallo!
Zunächst wieder vielen Dank!
Die Tabelle ist praktisch nicht von datenschutzrelevanten Daten zu befreien. Dafür ist sie zu groß, umfangreich und verschachtelt.
Eine Beispieldatei war daher wirklich schwierig zu erstellen.
Mir hat die Unterstützung jedoch bereits sehr geholfen.
Inzwischen läuft das Makro fehlerfrei und wie gewünscht durch.
Das Problem mit dem Filter habe ich über eine Hilfszeile gelöst.
Das Ende der Schleife bzw. Fehler habe ich jetzt mit On Error GoTo Ende
gelöst:

Sub Uebertragung_alleMA()
'Application.ScreenUpdating = False
Dim MA As String
Dim spalte As Long
Dim rgefunden As Range
With Sheets("Plan")
.Unprotect Password:="1234"
For spalte = Range("P1").Column To ActiveSheet.UsedRange.Columns.Count
.Select 'kann entfallen
'filtert die Fortbildungen, die der Mitarbeiter besucht hat
.Range("MA_FOBI_Anfang:MA_FOBI_Ende").AutoFilter Field:=spalte - 15, Criteria1:=""
.Range("AOK_FOBI_Anfang:AOK_FOBI_Ende").Copy
On Error GoTo Ende
MA = .Cells(1, spalte)
'kopiert die erfolgten Fortbildungen in das Registerblatt des Mitarbeiters
With Sheets(MA)
.Select  'kann entfallen
freizeile = .Cells(Rows.Count, 3).End(xlUp).Row + 1
.Cells(freizeile, 2).PasteSpecial Paste:=xlPasteValues, _
Operation:=xlNone, _
SkipBlanks:=False, _
Transpose:=False
End With
'setzt die Filtereinstellungen zurueck
.Select 'kann entfallen
.Range("MA_FOBI_Anfang:MA_FOBI_Ende").AutoFilter Field:=spalte - 15
'faerbt den Mitarbeiter in der Kopfzeile unter "Plan!" gruen ein
With .Range(.Cells(1, spalte), .Cells(9, spalte))
.Select 'kann entfallen
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorAccent3
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End With
Next spalte
.Protect Password:="1234"
End With
'Application.ScreenUpdating = True
Ende:
End Sub
Ich danke nochmals für die Hilfe. Alleine wäre ich hier vermutlich nie zum Ziel gelangt.
Ein erholsames Wochenende!
Ihr seit super!!!
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige