Hallo zusammen,
ich hab ein Problem.
Ich habe einen Fragebogen, der Daten als Datensatz liefert.
https://www.herber.de/bbs/user/89963.xlsx
In der Auswertung (MASTER) werden die Daten aus dem Datensatz (Fragebogen) in eine druckfähige Version transponiert.
Ich habe ein Makro geschrieben, dass den Link aus dem Fragebogen um eine Zeile nach unten verschiebt und für jede Zeile aus dem Fragebogen ein Datenblatt macht.
Jetzt möchte ich nicht für jede Zeile diese Verschiebung ausprogrammieren. Gibt es eine nette Schleife, die es mir abnimmt, dass nicht alles ausprogrammieren muss?
Es gibt bis zu 100 Zeilen, daher wäre der Code sehr lang und sehr viel Arbeit
Das Makro lautet:
Sub Erstellen_Berichte()
'
' neues Blatt anlegen
Sheets("MASTER").Select
Sheets("MASTER").Copy after:=Sheets(2)
'Werte ersetzen
Range("M9").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-6]C[-7]"
Range("F11").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-8]C[2]"
Range("F13:G13").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-10]C[3]"
Range("I14").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-11]C[1]"
Range("M14").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-11]C[-2]"
Range("I18").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-15]C[4]"
Range("K16:M16").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-13]C[1]"
Range("M18").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-15]C[1]"
Range("Q18:R18").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-15]C[-2]"
Range("Q20").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-17]C"
Range("N21").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-18]C[4]"
Range("K22").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-19]C[8]"
Range("C24:R24").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-21]C[13]"
Range("Q29").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-26]C[5]"
Range("Q31").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-28]C[6]"
Range("K32").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-29]C[13]"
Range("O33:P33").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-30]C[10]"
Range("I34").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-31]C[17]"
Range("Q36").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-33]C[11]"
Range("Q38").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-35]C[12]"
Range("Q40").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-37]C[13]"
Range("Q42").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-39]C[14]"
Range("M18").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-52]C[24]"
Range("J61:Q61").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-58]C[-5]"
Range("E4:N4").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-1]C[-3]"
Range("N5").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-2]C[-11]"
Range("P5").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-2]C[-12]"
Range("M18").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-15]C[1]"
Range("C55:R55").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-52]C[24]"
Range("R27").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-24]C[3]"
Range("n27").Select
ActiveCell.FormulaR1C1 = "=Fragebogen!R[-24]C[6]"
' Werte fixieren
Range("A1:R239").Select
ActiveWindow.SmallScroll Down:=-240
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Blatt umbenennen
Zelle = "e4"
ActiveSheet.Name = ActiveSheet.Range(Zelle).Text
Kann mir da Irgendjemand helfen?
LG
David