Daten kopieren bzw. Untergliederung erstellen

[Mendrin]

Hallo zusammen,



danke das es so kompentente Anlaufstellen gibt!



Ich stehe vor einer Excel Herausforderung :)



Ich habe eine Liste mit 600 ID's



ID_0001

ID_0002

ID_0003

... und so weiter



Nun sollen unter 600 Eintrage weiter 8 Untergliederungen gebildet werden. bzw. alle Datensätze sollen 8x kopiert werden.

Das ganze soll anschließend so aussehen:



ID_0001_1

ID_0001_2

ID_0001_[...]

ID_0001_8

ID_0002_1

ID_0002_2

ID_0002_[...]

ID_0002_8
ID_0003_1


und so weiter.

Beim kopieren sollen wenn möglich alle Spalten des Datensatzen auch übernommen werden (Vorname, Nachname, Adresse etc.). Sodass 8 identische Datensätze enstehen, jedoch mit den 8 unterschiedlichen ID's.

Ich hoffe ich konnte das einigermaßen erklären.



Es wäre super, wenn mir jemand helfen könnte :).



LG,

Kevin

[UweD]

Hallo

versuch es mal mit diesem Makro

Code:

Sub tt()
    On Error GoTo Fehler
    Dim TB1 As Worksheet, i As Long, Neu As Integer
    Dim Sp As Integer, ZE As Integer, LR As Long
    Const APPNAME = "TT"
   
   
    '*** bescheunigt das Makro
    Application.ScreenUpdating = False
   
   
    '*** Stammdaten Anfang
    Set TB1 = Sheets("Tabelle1")
    Sp = 1 'Spalte A
    ZE = 1 'ab Zeile
    Neu = 8 'Anzahl zusätzliche Zeilen
    '*** Stammdaten Ende
   
    With TB1
        LR = .Cells(.Rows.Count, Sp).End(xlUp).Row 'letzte Zeile der Spalte
       
        For i = LR To ZE Step -1
            .Rows(i + 1).Resize(Neu).Insert xlDown
            .Rows(i).Copy .Rows(i + 1).Resize(Neu)
            With .Cells(i + 1, Sp).Resize(Neu, 1)
                .FormulaR1C1 = "=R" & i & "C1&""_""&ROW(R[-" & i & "]C)"
                .Value = .Value
            End With
        Next
    End With
   
   
   
    '*** Fehlerbehandlung
    Err.Clear
Fehler:
    If Err.Number <> 0 Then MsgBox "Fehler in Sub """ & APPNAME & """" & vbCrLf _
        & "Fehlernummer: " & Err.Number & vbLf & Err.Description: Err.Clear
End Sub

LG UweD

[Mendrin]

Vielen, vielen Dank!
Hat wunderbar geklappt.

Ich bin so dankbar :)

[WillWissen]

Moin,

Mendrin hat eine passende VBA-Lösung bekommen. Für Mitlesende bzw. Suchende mit ähnlichem Problem, die keine Makros einsetzen dürfen, hier noch eine Formellösung:

Arbeitsblatt mit dem Namen 'Tabelle1'
	A	B
1	ID_0001	ID_0001_1
2	ID_0002	ID_0001_2
3	ID_0003	ID_0001_3
4		ID_0001_4
5		ID_0001_5
6		ID_0001_6
7		ID_0001_7
8		ID_0001_8
9		ID_0002_1
10		ID_0002_2
11		ID_0002_3
12		ID_0002_4
13		ID_0002_5
14		ID_0002_6
15		ID_0002_7
16		ID_0002_8
17		ID_0003_1
18		ID_0003_2
19		ID_0003_3
20		ID_0003_4
21		ID_0003_5
22		ID_0003_6
23		ID_0003_7
24		ID_0003_8

Zelle	Formel
B1	=INDEX($A$1:$A$20;AUFRUNDEN((ZEILE())/8;0))&"_"&REST(ZEILE()-1;8)+1

Verwendete Systemkomponenten: [Windows (32-bit) NT 10.00] MS Excel 2016

Diese Tabelle wurde mit Tab2Html (v2.6.0) erstellt. ©Gerd alias Bamberg

Die neue Spalte kopieren, als Werte wieder einfügen und die Haupt-IDs darunter einfügen. A-Z sortieren.