Sortiermakro funktioniert nicht richtig

Question

Ich habe ein Makro geschrieben, um Zeilen aus einem Blatt ("Neue Anbieter - FPPE") in mehrere Blätter zu schneiden und einzufügen, basierend auf einer Spalte (H). Als ich es zum ersten Mal benutzt habe, funktionierte es gut, aber wenn ich dem Sortierblatt zusätzliche Daten hinzugefügt habe ("New Providers - FPPE"), funktioniert es nicht vollständig. Das Makro schneidet weiterhin die Zeilen von "New Providers - FPPE" ab, aber die Zeilen werden nicht in die Blätter eingefügt. Ich habe keine Ahnung, wohin die Reihen gehen. Hat jemand einen Einblick, was passieren könnte? Ich bin sehr neu im Schreiben von Makros, so dass jede Hilfe geschätzt wird!

Option Explicit 

Sub Fr33M4cro() 

Dim sh33tName As String 
Dim custNameColumn As String 
Dim i As Long 
Dim stRow As Long 
Dim customer As String 
Dim ws As Worksheet 
Dim sheetExist As Boolean 
Dim sh As Worksheet 

sh33tName = "New Providers - FPPE" 
custNameColumn = "H" 
stRow = 7 

Set sh = Sheets(sh33tName) 

For i = sh.Range(custNameColumn & sh.Rows.Count).End(xlUp).Row To stRow Step -1 
    customer = sh.Range(custNameColumn & i).Value 
    For Each ws In ThisWorkbook.Sheets 
     If StrComp(ws.Name, customer, vbTextCompare) = 0 Then 
      sheetExist = True 
      Exit For 
     End If 
    Next 
    If sheetExist Then 
     CopyRow i, sh, ws, custNameColumn 
    Else 
     InsertSheet customer 
     Set ws = Sheets(Worksheets.Count) 
     CopyRow i, sh, ws, custNameColumn 
    End If 
    Reset sheetExist 
Next i 

End Sub 

Private Sub CopyRow(i As Long, ByRef sh As Worksheet, ByRef ws As Worksheet, custNameColumn As String) 
Dim wsRow As Long 
wsRow = ws.Range(custNameColumn & ws.Rows.Count).End(xlUp).Row + 1 


ws.Rows(wsRow).EntireRow.Value = sh.Rows(i).EntireRow.Value 
sh.Rows(i).EntireRow.Delete 
End Sub 


Private Sub Reset(ByRef x As Boolean) 
x = False 
End Sub 

Private Sub InsertSheet(shName As String) 
Worksheets.Add(After:=Worksheets(Worksheets.Count)).Name = shName 
End Sub 

Answer 1

Ich schlage vor, Sie InsertSheet Unter zu einer Funktion ändern, die einen Verweis auf das eingefügte Arbeitsblatt zurückzugibt:

Function InsertSheet(shName As String) As Worksheet 
    Set InsertSheet = Worksheets.Add(After:=Worksheets(Worksheets.Count)) 
    InsertSheet.Name = shName 
End Function 

dann diesen Teil des Codes ändern:

InsertSheet customer 
    Set ws = Sheets(Worksheets.Count) 
    CopyRow i, sh, ws, custNameColumn 

dazu :

Set ws = InsertSheet(customer) 
    CopyRow i, sh, ws, custNameColumn