VBA - Daten aus einer Liste mit Schleife kopieren
19.12.2018 14:05:02
Pascal
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