13.08.2018, 20:11
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!
Viel Spaß damit!
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 SubViel Spaß damit!