Problem beim sortieren mit VBA
09.03.2022 22:16:09
Johannes
ich benötige etwas Hilfe.
Ziel ist es einen Namen aus einer oder zwei Dateien in eine oder zwei andere Dateien zu kopieren.
Ich habe eine Userform erstellt, wo man per ComboBoxen den Namen auswählt, eine Zieldatei (gleicher Aufbau/Inhalt) angibt, Zeilenauswahl für Datei Nr1, und ob der Name nur in einer Datei oder beiden kopiert werden soll.
In der zweiten Datei soll der Name erst gesucht werden und in ein Freies Feld eines bestimmen Bereichs kopiert werden (je nachdem aus welcher Zeile in der Quelle. Weil unterschiedlich zu Datei 1)). Anschießend der Bereich von A-Z sortiert.
An sich funktioniert mein Code einwandfrei. Nur wird beim ersten Verschieben nicht sortiert. Der neue Name bleibt da stehen wo er eingefügt wird. Wenn ich allerdings das Makro ein zweites mal ausführe, wird der Bereich mit dem zuvor neu eingefügten Namen richtig von A-Z sortiert, nur der zweite Name steht jetzt wieder da wo er eingefügt wurde (Am Ende weil ja zuvor sortiert wurde). Die Sortierfunktion wird aber eigentlich erst nach dem einfügen ausgeführt..... Komme nicht dahinter was da schief läuft.
Hier der Code-Abschnitt wo die zweite Datei abgearbeitet wird.
(PS. Habe immer diese Workbooks und Workssheets .Select weil es sonst nicht funktionierte. Der Sortier-Teil funktioniert auch wenn ich ihn zum testen in ein eigenes Sub, mit den entsprechenden Variablen, stecke.)
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Application.EnableEvents = False
' Verschiedene Gültigkeitsabfragen der ComboBoxen ______________________________________________________________
'Auch in den Anwesenheitslisten kopieren, wenn Haken gesetzt___________________________________________________________________________________
If CheckBox1.Value = True Then
Workbooks(ThisWorkbook.Name).Activate
Workbooks(ThisWorkbook.Name).Sheets("Einstellungen").Select
QMAAnwesenheit = Workbooks(ThisWorkbook.Name).Worksheets("Einstellungen").Cells(VerschiebenVon, 2).Value
vonAnwesenheitVerschieben = Workbooks(ThisWorkbook.Name).Sheets("Einstellungen").Range("AH17").Value
Workbooks(inSchichtplandateiVerschieben).Activate
Workbooks(inSchichtplandateiVerschieben).Sheets("Einstellungen").Select
inAnwesenheitVerschieben = Workbooks(inSchichtplandateiVerschieben).Sheets("Einstellungen").Range("AH17").Value
If vonAnwesenheitVerschieben = inAnwesenheitVerschieben Then
MsgBox "In beiden Schichtplänen wird auf die gleiche Anwesenheitsdatei verwiesen. Kopieren nicht nötig. (Haken bei 'Anwesenheit berücksichtigen' entfernen.)"
Exit Sub
End If
If Not Dir(ThisWorkbook.Path & "\" & inAnwesenheitVerschieben) "" Then
MsgBox "Die Ziel-Anwesenheitsdatei '" & inAnwesenheitVerschieben & "' konnte nicht gefunden werden. (In Einstellungen des anderen Schichtplan angeben.)"
Exit Sub
End If
If Not Dir(ThisWorkbook.Path & "\" & vonAnwesenheitVerschieben) "" Then
MsgBox "Die Quell-Anwesenheitsdatei '" & vonAnwesenheitVerschieben & "' konnte nicht gefunden werden. (In Einstellungen dieses Schichtplan angeben.)"
Exit Sub
End If
Workbooks.Open (ThisWorkbook.Path & "\" & vonAnwesenheitVerschieben)
Workbooks(vonAnwesenheitVerschieben).Activate
If Workbooks(vonAnwesenheitVerschieben).ReadOnly = True Then
MsgBox "Anwesenheit " & vonAnwesenheitVerschieben & " ist schreibgeschützt. Aktion nicht möglich."
Exit Sub
End If
Workbooks.Open (ThisWorkbook.Path & "\" & inAnwesenheitVerschieben)
Workbooks(inAnwesenheitVerschieben).Activate
If Workbooks(inAnwesenheitVerschieben).ReadOnly = True Then
MsgBox "Anwesenheit " & inAnwesenheitVerschieben & " ist schreibgeschützt. Aktion nicht möglich."
Exit Sub
End If
Workbooks(vonAnwesenheitVerschieben).Activate
Workbooks(vonAnwesenheitVerschieben).Sheets("Anwesenheit").Select
ZeileMAAnwesenheit = 1
Dim Passwort As String
Passwort = Workbooks(vonAnwesenheitVerschieben).Worksheets("Einstellungen").Cells(11, 11).Value
Workbooks(vonAnwesenheitVerschieben).Unprotect Password:=Passwort
Workbooks(vonAnwesenheitVerschieben).Worksheets("Anwesenheit").Unprotect Password:=Passwort
Workbooks(vonAnwesenheitVerschieben).Worksheets("Anwesenheit").Rows("16:105").EntireRow.Hidden = False
Dim BenutzerSuche As Range
For Each BenutzerSuche In Workbooks(vonAnwesenheitVerschieben).Worksheets("Anwesenheit").Range("A16:A105") ' Bereich wo die Benutzer stehen
If LCase(QMAAnwesenheit) = LCase(Workbooks(vonAnwesenheitVerschieben).Worksheets("Anwesenheit").Cells(BenutzerSuche.Row, BenutzerSuche.Column).Value) Then
ZeileMAAnwesenheit = BenutzerSuche.Row
Exit For
End If
Next BenutzerSuche
If ZeileMAAnwesenheit = 1 Then
Workbooks(vonAnwesenheitVerschieben).Worksheets("Anwesenheit").Rows("16:105").EntireRow.Hidden = True
MsgBox "Mitarbeiter in Anwesenheitsliste nicht gefunden. Aktion abgebrochen."
Application.DisplayAlerts = False
Workbooks(vonAnwesenheitVerschieben).Close savechanges:=False
Workbooks(inAnwesenheitVerschieben).Close savechanges:=False
Application.DisplayAlerts = True
Exit Sub
End If
Workbooks(inAnwesenheitVerschieben).Activate
Workbooks(inAnwesenheitVerschieben).Sheets("Anwesenheit").Select
Passwort = Workbooks(inAnwesenheitVerschieben).Worksheets("Einstellungen").Cells(11, 11).Value
Workbooks(inAnwesenheitVerschieben).Unprotect Password:=Passwort
Workbooks(inAnwesenheitVerschieben).Worksheets("Anwesenheit").Unprotect Password:=Passwort
Workbooks(inAnwesenheitVerschieben).Worksheets("Anwesenheit").Rows("16:105").EntireRow.Hidden = False
Dim BereichGruppe As String
If ZeileMAAnwesenheit >= 16 And ZeileMAAnwesenheit = 47 And ZeileMAAnwesenheit