(Für mich) Komplizierte Geschichte

[Frogger1986]

Also grundsätzlich würde ich auch dazu raten zukünftig die Struktur der Tabelle zu verändern! 
Der Code ist geschrieben auf die Struktur der Beispieldatei ( Im Anhang )! Er fügt für jeden Kunden ein Tabellenblatt hinzu und ein Tabellenblatt in dem alle Kundennummern in form eines Hyperlinks gelistet werden!

Code:

Sub umstellung()
Dim Neues As String
Dim Blatt As String
Dim ws As Worksheet

On Error Resume Next

Letzte = Sheets("07689").Cells(Rows.Count, 2).End(xlUp).Row + 1

For i = 2 To Letzte

   
       
       Blatt = Sheets("07689").Cells(i, 2).Value
       If SheetEx = Sheets(Blatt).Index > 0 Then
               Worksheets.Add After:=Worksheets(Worksheets.Count)
               ActiveSheet.Name = Sheets("07689").Cells(i, 2).Value
               Application.Wait (Now + TimeValue("0:00:2"))
       End If
       
       Letzte2 = Sheets(Blatt).Cells(Rows.Count, 1).End(xlUp).Row + 1
       Sheets(Blatt).Cells(Letzte2, 1) = Sheets("07689").Cells(i, 1).Value
       Sheets(Blatt).Cells(Letzte2, 2) = Sheets("07689").Cells(i, 3).Value
       Sheets(Blatt).Cells(Letzte2, 3) = Sheets("07689").Cells(i, 4).Value
       Sheets(Blatt).Cells(Letzte2, 4) = Sheets("07689").Cells(i, 5).Value
       Sheets(Blatt).Cells(Letzte2, 5) = Sheets("07689").Cells(i, 6).Value
       Sheets(Blatt).Cells(Letzte2, 6) = Sheets("07689").Cells(i, 7).Value
       Sheets(Blatt).Cells(Letzte2, 7) = Sheets("07689").Cells(i, 8).Value
       Sheets(Blatt).Cells(Letzte2, 8) = Sheets("07689").Cells(i, 9).Value
       Sheets(Blatt).Cells(Letzte2, 9) = Sheets("07689").Cells(i, 10).Value
Next

For Each Sheet In Sheets
 
 If Sheet.Index > 1 Then
   Sheet.Select
   ActiveSheet.Range("A1") = "Auf_Liefertag"
   ActiveSheet.Range("B1") = "Artikel_Nummer"
   ActiveSheet.Range("C1") = "Artikel"
   ActiveSheet.Range("D1") = "Herkunftsland"
   ActiveSheet.Range("E1") = "Position_Menge"
   ActiveSheet.Range("F1") = "Ein_Langtext"
   ActiveSheet.Range("G1") = "Einzel_Preis"
   ActiveSheet.Range("H1") = "Positions_Rabatt"
   ActiveSheet.Range("I1") = "Positions_Wert"
   Letzte3 = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
   ActiveSheet.Range ("A1:I" & Letzte3)
   ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$I$" & Letzte3), , xlYes).Name = ActiveSheet.Name
 End If

Next

Worksheets.Add Before:=Sheets(1)
ActiveSheet.Name = "Kundenstamm"
For e = 3 To Sheets.Count

   ActiveSheet.Cells(e - 1, 1).FormulaLocal = "=Hyperlink(""#""&""" & Sheets(e).Name & "!A1" & """;""" & Sheets(e).Name & """)"
   
Next
Letzte4 = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$A$" & Letzte4), , xlYes).Name = ActiveSheet.Name


End Sub

Viel Spaß damit!

[Frogger1986]

So jetzt is es auch noch schön formatiert...

[Barney76]

Wow - das sieht erst mal super aus.....

Ich hoffe, dass ich das noch angepasst bekomme, wenn das dann mit den echten Daten passieren muss....

Im Notfall komme ich nochmal auf dich zurück...

Vielen, vielen vielen Dank