Thema: Werte aus Liste in x Blätter

Hallo,
ich möchte folgendes realisieren:
Ich habe eine Liste mit x Kostenstellen und daneben Werte für 12 Perioden.
Ich erstelle per Makro x idendtische (Ziel)Blätter, die Nummerierung erfolgt numerisch von 1 bis x. Die Werte jeder Kostenstelle sollen nun in die einzelnes Blätter kopiert werden (eine Zeile je Blatt) . Zusätzlich soll die Nr der KST im Zielblatt in B3 eingefügt werden und die Bezeichnung in C3
Hier eine Beispieldatei.
https://www.herber.de/bbs/user/53649.xls
Ich hoffe Ihr könnt mir helfen.
Micha

Hallo Micha,
probier mal

Sub Uebertragen()
Dim wksEin As Worksheet, rng As Range, intNr As Integer
Set wksEin = Sheets("Einlesen")
For Each rng In wksEin.Range(Cells(2, 3), _
Cells(Cells(Rows.Count, 3).End(xlUp).Row, 3))
intNr = intNr + 1
With Sheets(CStr(intNr))
rng.Resize(, 12).Copy .Cells(7, 3)
rng.Offset(, -2).Resize(, 2).Copy .Cells(3, 2).Resize(, 2)
End With
Next rng
End Sub

Hier wird nicht geprüft, ob die Ausgabeblätter vorhanden sind, dafür sollte dein Makro schon sorgen.
(Einfacher wäre wohl, Erstellen und Kopieren in einem Makro zusammenzufassen.)
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Hallo Erich,
vielen Dank für Deine Hilfe. In der Beispieldatei läuft das Makro swoeit ganz gut. Wenn ich es allerdings in meinen bestehenden Code einfüge bekomme ich folgende Meldung: "Anwendungs- oder objektdefinierter Fehler" und zwar an dieser Stelle:
For Each rng In wks1.Range(Cells(2, 3), _
Cells(Cells(Rows.Count, 3).End(xlUp).Row, 3))
das gesamte Makro sieht im Moment so aus:

Sub Datentransfer_AFA()
Dim wks, wks1, wks2 As Worksheet
Dim i, Anzahl, intNr As Integer
Dim rng As Range
'# Anzahl der zu erstellenden Kopien eingeben
Anzahl = InputBox("Kopienanzahl eingeben")
'# SAP Uploaddatei kopieren
Set wks = Worksheets("Sheet1")
ActiveSheet.Unprotect
For i = 1 To Anzahl
wks.Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = i
Next i
For i = 1 To Anzahl
Set wks2 = Worksheets(Format(i, "0"))
'# vorhandene Daten im Zielbereich löschen
wks2.Range(wks2.Cells(7, 1), wks2.Cells(1000, 14)).ClearContents
Next i
Set wks1 = Worksheets("Einlesen")
For Each rng In wks1.Range(Cells(2, 3), _
Cells(Cells(Rows.Count, 3).End(xlUp).Row, 3))
intNr = intNr + 1
With Sheets(CStr(intNr))
rng.Resize(, 12).Copy .Cells(7, 3)
rng.Offset(, -2).Resize(, 2).Copy .Cells(3, 2).Resize(, 2)
End With
Next rng
End Sub

vielleicht hast Du noch eine Idee woran es liegen kann?
Micha

Hallo Micha,
sorry, in meinem Code war ein Fehler. Statt
wksEin.Range(Cells(2, 3), Cells(Cells(Rows.Count, 3).End(xlUp).Row, 3))
hätte da stehen sollen
Range(wksEin.Cells(2, 3), wksEin.Cells(wksEin.Cells(wksEin.Rows.Count, 3).End(xlUp).Row, 3))
Aber das spielt jetzt keine Rolle mehr, denn die Erstellung der neuen Blätter und das Kopieren
lässt sich einfacher und schneller in einem Rutsch erledigen (siehe unten im neuen Code).
Soll die Anzahl eingegeben oder aus der Zeilenzahl des Blatts "Einlesen" bestimmt werden?
Ich hab unten mal beide Möglichkeiten hingeschrieben - eine kannst du löschen.
In der alten Prozedur richtete sich die Zahl der anzulegenden Blätter nach der Eingabe,
kopiert werden sollten aber ALLE Zeilen des Quellblatts.
Noch eine Bemerkung: Mit
Dim wks, wks1, wks2 As Worksheet
werden NICHT drei Worksheet-Objekte deklariert. Hier ist nur wks2 ein Worksheet,
zu wks und wks1 fehlt die Angabe, also sind das Variant-Variablen.
Probier mal

Sub Datentransfer_AFA()
Dim wks As Worksheet, i As Integer, Anzahl As Integer
Set wks = Worksheets("Sheet1")
wks.Unprotect
With Worksheets("Einlesen")
'# Anzahl der zu erstellenden Kopien eingeben
Anzahl = .Cells(.Rows.Count, 3).End(xlUp).Row - 1 ' wenn für alle Zeilen
Anzahl = InputBox("Kopienanzahl eingeben")        ' wenn für eingegebene Zahl
'# SAP Uploaddatei kopieren
For i = 2 To Anzahl + 1
wks.Copy after:=Worksheets(Worksheets.Count)
ActiveSheet.Name = CStr(i - 1)
'# vorhandene Daten im Zielbereich löschen
Range(Cells(7, 1), Cells(1000, 14)).ClearContents
'# Daten von Blatt "Einlesen" kopieren
.Cells(i, 1).Resize(, 2).Copy Cells(3, 2)
.Cells(i, 3).Resize(, 12).Copy Cells(7, 3)
'# Spaltenbreite automatisch
Range(Columns(1), Columns(14)).AutoFit
Next i
End With
End Sub

Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
P.S.: Einfacher wäre das Ganze gewesen, wenn du deine Mappe gleich inklusive Modul gepostet hättest.

Hallo Erich,
jetzt ist er perfekt! Danke noch mal, Du hast mir eine Menge Handarbeit erspart!
Dein Hinweis mit der Beispieldatei ist angekommen - werde ich beim nächsten mal so machen!
Zwei Verständnissfragen hab ich allerdings noch:
Ich verrstehe folgende Codezeilen noch nicht so richtig, kanns Du das mal bitte kurz erläutern?:
1. .Cells(.Rows.Count, 3).End(xlUp).Row - 1 (ich komme mit solchen Bereichsbestimmungen nicht klar... :o( )
2. .Cells(i, 1).Resize(, 2).Copy Cells(3, 2)
.Cells(i, 3).Resize(, 12).Copy Cells(7, 3)
bei Nr 2 interessiert mich folgendes: was hat das Resize zu bedeuten? Und ich verstehe nicht so recht an welcher Stelle von "Einesen" nach "i" gewechselt wird?
Micha

Also zu
.Cells(i, 1).Resize(, 2).Copy Cells(3, 2)
.Cells(i, 3).Resize(, 12).Copy Cells(7, 3)
habe ich mich jetzt mal belesen und das ist auch soweit klar. Allerdings ist immer noch unklar, wie Du das "wechseln" vom Blatt "Einlesen" zum Zielblatt hin bekommst.
Micha

Hi Micha,
da wird gar nicht gewechselt.
Für "Einlesen" habe ich die With-Klammer
With Worksheets("Einlesen")
geschrieben.
Alle Bereichsangaben in der Klammer, die mit einem Punkt beginnen,
beziehen sich dann auf Worksheets("Einlesen")
Schau dir mal in der Hilfe "With" an. Das ist ungemein praktisch, übersichtlich, schnell.
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort