VGA Hilfe
15.09.2023 17:53:36
Yal
Hallo Emju,
ich weiss nicht, was ein "Hotkey" ist. Ich kenne Shift, Strg, Alt, AltGr, Capslock, NumLock, ...
Ich sehe in dein Code nicht, was von Tastatur sich beeinflussen lässt.
Könnte es sein, dass im Hauptblatt 3 Zeilen unter der scheinbar letzte befüllte Zeile in Spalte A eine Zelle (oder 3) so etwas wie einen Leerzeichen enthalten?
Es müsste zwar dazu einen "x" in Spalte 6 oder 7 , ... aber dann wären diese Zeilen kopiert, was bei einem Sortierung dann oben gebracht werden.
Code geputzt:
Sub SpeichereNeuenEintrag()
Daten_kopieren
Sortieren
End Sub
Private Sub Daten_kopieren()
Dim Zelle As Range
Dim Arr
Dim ZielBlatt As Worksheet
' Durchlaufe alle Zeilen in der Tabelle auf der Hauptseite.
With ThisWorkbook.Worksheets("Hauptseite")
For Each Zelle In Range(.Range("A2"), .Cells(Rows.Count, 1).End(xlUp)) ' Annahme: Die Daten beginnen in Zeile 2 (Zeile 1 enthält Überschriften).
Arr = Zelle.Resize(1, 5).Value
' Durchlaufe alle Kategorien und überprüfe, ob ein "x" gesetzt ist.
For Each ZielBlatt In ThisWorkbook.Sheets
If ZielBlatt.Name > "Hauptseite" Then
If .Cells(Zell.Row, ZielBlatt.Index + 5).Value = "x" Then ' Annahme: Kategorien beginnen in Spalte 6 (am6, am7, usw.).
ZielBlatt.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 5) = Arr
End If
End If
Next ZielBlatt
Next Zelle
End With
End Sub
Private Sub Sortieren()
Dim ws As Worksheet
' Sortiere die Daten in den Zielblättern nach Firma und dann alphabetisch.
For Each ws In ThisWorkbook.Worksheets
If ws.Name > "Hauptseite" Then
With ws.Sort
.SortFields.Clear
.SortFields.Add Key:=ws.Range("A1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SortFields.Add Key:=ws.Range("B1"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange ws.Range("A1:E" & ws.Cells(Rows.Count, 1).End(xlUp).Row)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End If
Next ws
End Sub
Diese Code-Zeile ist unstabil:
If .Cells(Zell.Row, ZielBlatt.Index + 5).Value = "x" Then ' Annahme: Kategorien beginnen in Spalte 6 (am6, am7, usw.).
Hauptblatt hat Index 1, daher die erste Zielblatt 2, gelesene Spalte für den "x": Spalte 7
Arbeite lieber mit den Blattname in einer Überschriftzeile:
Private Function X_lesen(Zeile As Long, Blattname As String) As Boolean
Dim R
On Error Resume Next
'suche den Blattname im Überschrift (Zeile 1)
With Worksheets("Hauptseite")
Set R = .Rows(1).Find(Blattname)
If Not R Is Nothing Then X_lesen = LCase(Trim(.Cells(Zeile, R.Column).Value)) = "x"
End If
End Function
dann wird es
If X_Lesen(Zell.Row, ZielBlatt.Name) Then ' Annahme: Kategorien beginnen in Spalte 6 (am6, am7, usw.).
VG
Yal