Excel Vba Kopieren und Einfügen von Daten basierend auf Kriterienüberschriften in mehrere Arbeitsblätter
Moin,
komme bei einer copy and paste Aufgabe nicht voran.
Ich habe mehrere Tabellen zu unterschiedlichen Aufträgen, die untereinander mit einer variablen Zeilenanzahl in einem Arbeitsblatt aufgelistet sind. Den Auftragsnamen sowie die Tabelle darunter möchte ich kopieren und in der selben Arbeitsmappe in unterschiedliche Arbeitsblätter einfügen. Dabei haben die Arbeitsblätter die Namen der Aufträge, sprich Auftrag 1, Auftrag 2 etc.
Hoffe könnt mir da weiterhelfen.
Grüße
Basti
komme bei einer copy and paste Aufgabe nicht voran.
Ich habe mehrere Tabellen zu unterschiedlichen Aufträgen, die untereinander mit einer variablen Zeilenanzahl in einem Arbeitsblatt aufgelistet sind. Den Auftragsnamen sowie die Tabelle darunter möchte ich kopieren und in der selben Arbeitsmappe in unterschiedliche Arbeitsblätter einfügen. Dabei haben die Arbeitsblätter die Namen der Aufträge, sprich Auftrag 1, Auftrag 2 etc.
Hoffe könnt mir da weiterhelfen.
Grüße
Basti
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 3935996689
Url: https://administrator.de/forum/excel-vba-kopieren-und-einfuegen-von-daten-basierend-auf-kriterienueberschriften-in-mehrere-arbeitsblaetter-3935996689.html
Ausgedruckt am: 25.12.2024 um 08:12 Uhr
12 Kommentare
Neuester Kommentar
Moin.
Der Wert "A" im If in Zeile 9 und das "Tabelle1" in Zeile 4 müssen natürlich an die eigenen Gegebenheiten angepasst werden...
Cheers
certguy
Sub Kopiere_Tabellen()
On Error Resume Next
Dim ws As Worksheet, cell As Range, intLast As Long, wsNew As Worksheet, r As Long
Set ws = Sheets("Tabelle1")
With ws
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
intLast = lastrow
For r = lastrow To 1 Step -1
If .Cells(r, "A").Value = "A" Then
Set wsNew = Sheets(.Cells(r - 1, "A").Value)
If Err.Number <> 0 Then
Set wsNew = Sheets.Add(After:=Sheets(Sheets.Count))
wsNew.Name = .Cells(r - 1, "A").Value
Err.Clear
Else
wsNew.Range("A:I").Clear
End If
.Range(.Cells(intLast, "I"), .Cells(r - 1, 1)).Copy Destination:=wsNew.Range("A1")
intLast = r - 3
End If
Next
End With
End Sub
Cheers
certguy
Zitat von @Bastian94:
Wäre da eine For Each schleife nötig, um die Daten bei bereits existierenden Arbeitsblättern einzutragen?
Nein nicht zwingend, Ein "On Error Resume Next" einbauen und dann checken ob das Object nicht Nothing ist geht auch. S. Anpassung oben.Wäre da eine For Each schleife nötig, um die Daten bei bereits existierenden Arbeitsblättern einzutragen?
dass er restliche Daten, die täglich in diesen Arbeitsblättern gepflegt werden, löscht.
Macht das Skript doch hiermit.wsNew.UsedRange.Clear
Sonst wir hier nichts gelöscht.
Zitat von @Bastian94:
Hab das heute mehrmals getestet. Der komplette Content im Arbeitsblatt wird gelöscht und die Tabelle importiert.
Hab das heute mehrmals getestet. Der komplette Content im Arbeitsblatt wird gelöscht und die Tabelle importiert.
Habe ich ich doch oben schon geschrieben..
wsNew.UsedRange.Clear
Denn würdest du das nicht machen und in dem Bereich des Einfügens schon was stehen und der kopierte Inhalt kürzer sein als das was da vorher schon steht gibt's ja inkonsinstenzen ...
Also nochmal dein Vorhaben genau überdenken... Anpassen darst du ja gerne auch selbst, wir kennen deinen Workflow nicht!!!!!
Zitat von @Bastian94:
Jeglicher Inhalt soll nicht gelöscht werden, sondern nur die Range von Spalte A:I, wo die Tabelle täglich eingefügt wird :D
Siehe mein ergänzter Hinweis dazu im letzten Kommentar.Jeglicher Inhalt soll nicht gelöscht werden, sondern nur die Range von Spalte A:I, wo die Tabelle täglich eingefügt wird :D
Und warum änderst du das dann nicht passend??? Koppschüttel, wohl mal wieder copy n paster syndrom.
wsNew.Range("A:I").Clear
me => out. Schließen bitte nicht vergessen.
Cheers
cg