Hallo zusammen,
ich habe da eine Idee, die ich aber nicht selber hinbekomme.
Mein Dokument besteht aus 2 Tabellen, einer Stammdatentabelle und eine Vorlage, die für den Kunden ist.
Beide habe fast das gleiche Format.
Ich habe jetzt mit folgendem Code hinbekommen, dass aus den Stammdaten von den Zeilen, die in Spalte A mit x gekennzeichnet werden, nur ein bestimmter Bereich kopiert wird und nach der letzten genutzten Zeile angehängt wird.
Meine Idee ist jetzt, in der Stammdatentabelle in Spalte A die Positionsnummer (Zeilennummer) einzutragen, an der, der entsprechend ausgewählte Bereich, in der Kundentabelle eingefügt werden soll.
z.B. Eintrag in Spalte A, Zeile 1 = 20 Der Bereich der Zeile A aus den Stammdaten soll in Zeile 20 der Kundentabelle eingetragen werden,
Bei meinem Code markiere ich mehrere Zellen auf einmal. Das sollte hier auch funktionieren.
Sicherlich wäre es cool, wenn man erkennen würde, dass eine Position zweimal vergeben wurde.
Möchte jemand sich dieser Herausforderung annehmen. Ich bin schon froh, dass ich mit meinem minimalen Wissen, das geschafft habe, was ich habe.
Danke schon mal im Voraus
Hier noch mein Code:
Public Sub CopyRows()
Dim FinalRow As Long
Dim NextRow As Long
Dim NewRow As Long
Dim ThisValue As String
Dim x As Long
Sheets("Contact agent list").Select
' Find the last row of data / Finde die letzte genutzte Zeile
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
' Loop through each row / Schleife über jede dieser Zeilen
For x = 2 To FinalRow
' Decide if to copy based on column A / Auswahl welche Zeile entsprechend der Spalte A kopiert werden soll - wenn x dann kopieren
ThisValue = Cells(x, 1).Value
If ThisValue = "x" Then
'Range(Cells(x, 2), Cells(x, 3), Cells(x, 5).Resize(1, 10)).copy
Cells(x, 3).Resize(1, 9).copy 'Bereich ab Spalte 3 bis 9 kopieren
Sheets("Customer sheet").Select
NextRow = Cells(Rows.Count, 3).End(xlUp).Row
NewRow = NextRow + 1
Cells(NewRow, 3).Select 'Ab Spalte 3 einfügen
ActiveSheet.Paste
'ActiveSheet.Paste Destination:=Worksheets("Customer sheet").Range("B:K")
Sheets("Contact agent list").Select
End If
Next x
End Sub
|