Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

VBA - Daten aus einer Liste mit Schleife kopieren

VBA - Daten aus einer Liste mit Schleife kopieren
19.12.2018 14:05:02
Pascal
Hallo zusammen
Ich bin schon ganz verzweifelt und suche dringend nach Hilfe... :) Ich hoffe jemand kann mir helfen.
Ausgangslage:
*************
Eine Liste mit Mitarbeitern und derer Lohndaten. Tabellenblatt "Lohnliste Bereich", Bereich A7:AR20.
Ein Muster-Bonusblatt, welches per Knopfdruck für alle auf der Liste aufgeführten Mitarbeiter kopiert und mit Daten aus der Liste angereichert werden soll.
Das automatische Kopieren der Bonusblätter und das anreichern des ersten Blatts (mit absoluten Bezügen) hat soweit geklappt.
Das Ziel wäre aber, dass die Liste durchgegangen wird und die Daten pro Zeile (relative Bezüge) abgefüllt werden.
Mein Code sieht bisher so aus:

Sub Bonusblatt_erstellen()
Dim Zeile As Range
Dim WS As Worksheet
Dim Bereich As Range
Dim Test As Worksheet
Application.ScreenUpdating = False
Set Test = ThisWorkbook.Sheets("Lohnliste Bereich")
Set Bereich = Sheets("Lohnliste Bereich").Range("A7:A8")
For Each Zeile In Bereich
ThisWorkbook.Sheets("Bonusblatt 2018 Muster").Copy After:=Sheets(Sheets.Count)
Set WS = ActiveSheet
WS.Name = "temp"
Test.Activate
Sheets("Lohnliste Bereich").Range("A7").Copy
Sheets("temp").Range("C2").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Lohnliste Bereich").Range("B7").Copy
Sheets("temp").Range("C3").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Lohnliste Bereich").Range("C7").Copy
Sheets("temp").Range("C4").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Lohnliste Bereich").Range("I7").Copy
Sheets("temp").Range("C5").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Lohnliste Bereich").Range("J7").Copy
Sheets("temp").Range("C6").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Lohnliste Bereich").Range("H7").Copy
Sheets("temp").Range("C7").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Lohnliste Bereich").Range("E7").Copy
Sheets("temp").Range("C8").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Lohnliste Bereich").Range("N7").Copy
Sheets("temp").Range("C11").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Lohnliste Bereich").Range("R7").Copy
Sheets("temp").Range("C12").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Lohnliste Bereich").Range("M7").Copy
Sheets("temp").Range("J11").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Lohnliste Bereich").Range("Q7").Copy
Sheets("temp").Range("J12").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Lohnliste Bereich").Range("Y7").Copy
Sheets("temp").Range("G17").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Lohnliste Bereich").Range("Z7").Copy
Sheets("temp").Range("N17").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Lohnliste Bereich").Range("C4").Copy
Sheets("temp").Range("C20").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Lohnliste Bereich").Range("F7").Copy
Sheets("temp").Range("C50").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("Lohnliste Bereich").Range("G7").Copy
Sheets("temp").Range("C51").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Sheets("temp").Select
ActiveSheet.Name = Zeile.Value
Next Zeile
End Sub

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: VBA - Daten aus einer Liste mit Schleife kopieren
19.12.2018 14:25:25
Bernd
Servus Pascal,
bitte Beispieldatei mit Fakedaten und dem gewünschten Ergebnis hochladen, das baut dir hier sonst wahrscheinlich keiner nach...
Grüße, Bernd
AW: VBA - Daten aus einer Liste mit Schleife kopieren
19.12.2018 14:28:30
UweD
Hallo
Das Ziel wäre aber, dass die Liste durchgegangen wird und die Daten pro Zeile (relative Bezüge) abgefüllt werden.
verstehe nicht, was du damit meinst.
Momentan werden 2 Blätter erzeugt (für Jede Zelle im Bereich A7:A8)
Das klappt
Das Übertragen kannst du auch einfacher gestalten.
Sub Bonusblatt_erstellen()
    Dim Zeile As Range
    Dim WS As Worksheet
    Dim Bereich As Range
    Dim Test As Worksheet
    
    Application.ScreenUpdating = False
    
    Set Test = ThisWorkbook.Sheets("Lohnliste Bereich")
    Set Bereich = Sheets("Lohnliste Bereich").Range("A7:A8")
     
     For Each Zeile In Bereich
     
         ThisWorkbook.Sheets("Bonusblatt 2018 Muster").Copy After:=Sheets(Sheets.Count)
         Set WS = ActiveSheet
         WS.Name = "temp"
         Test.Activate
                               
         With Sheets("Lohnliste Bereich")
             WS.Range("C2") = .Range("A7")
             WS.Range("C3") = .Range("B7")
             '... 
         
             WS.Name = Zeile.Value
         
         End With
     
     Next Zeile

End Sub
LG UweD
Anzeige

338 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige