Formularvorlage mit Daten aus Tabelle automatisch ausfüllen

[vicky]

Hallo ihr Lieben,

ich hab ein kleines Problem in Excel und hoffe, dass mir jmd. weiterhelfen könnte.
Es geht um folgendes:

Ich habe eine Datei mit zwei Arbeitsblätter das eine Blatt ist gefüllt mit verschiedenen Daten, das andere ist eine Formularvorlage in die 4 Datensätze eingefügt werden können.

Was ich mir jetzt wünschen würde, wäre ein Programm, welches diese Formatvorlage kopiert und die ersten 4 Datensätze einträgt (falls weniger als 4 Datensätze vorhanden sind, dann eben nur die vorhandenen Datensätze dort einträgt).
Dies soll so lange wiederholt werden bis alle Datensätze abgearbeitet sind.

Ich hoffe es ist klar was ich damit meine. Falls nicht, würde ich um eine kurze Rückmeldung bitten, dann versuche ich es noch mal zu erläutern.
Beim Stöbern im Forum habe ich schon eine ähnliche Fragestellung gefunden und versucht die Lösungsvorschläge anzuwenden.

Mein Makro sieht folgendermaßen aus:

Code:

Sub Makro1Versuch1()
 
  Dim wks1 As Worksheet
  Dim wks2 As Worksheet
  Dim lngZ As Long, i As Long
  Set wks1 = Worksheets("Daten")
  Set wks2 = Worksheets("Vorlage Makro")
  lngZ = wks1.Cells(wks1.Rows.Count, 1).End(xlUp).Row
 
  For i = 2 To lngZ
     wks2.Copy After:=Sheets(Sheets.Count)
     With ActiveSheet
        .Cells(5, 1) = wks1.Cells(i, 2) ' IdentNr1
        .Cells(7, 2) = wks1.Cells(i, 2) ' IdentNr2
        .Cells(9, 2) = wks1.Cells(i, 2) ' IdentNr3
        .Cells(12, 2) = wks1.Cells(i, 3) ' Beschreibung
        .Cells(2, 1) = wks1.Cells(i, 4) ' L1
        .Cells(14, 9) = wks1.Cells(i, 4) ' L2
        .Cells(3, 2) = wks1.Cells(i, 5) ' KanbanBahnhof
        .Cells(3, 8) = wks1.Cells(i, 6) 'Anlieferstelle
        .Cells(9, 8) = wks1.Cells(i, 7) 'Anzahl Teile1
        .Cells(7, 8) = wks1.Cells(i, 7) 'Anzahl Teile2
        .Cells(14, 5) = wks1.Cells(i, 8) 'Karte Nr.
        .Cells(14, 7) = wks1.Cells(i, 9) 'Anz Karten
        .Cells(3, 10) = wks1.Cells(i, 10) ' Regal
        .Cells(14, 3) = wks1.Cells(i, 11) ' LET
       
        .Cells(19, 1) = wks1.Cells(i, 2) ' IdentNr1
        .Cells(21, 2) = wks1.Cells(i, 2) ' IdentNr2
        .Cells(23, 2) = wks1.Cells(i, 2) ' IdentNr3
        .Cells(26, 2) = wks1.Cells(i, 3) ' Beschreibung
        .Cells(16, 1) = wks1.Cells(i, 4) ' L1
        .Cells(28, 9) = wks1.Cells(i, 4) ' L2
        .Cells(17, 2) = wks1.Cells(i, 5) ' KanbanBahnhof
        .Cells(17, 8) = wks1.Cells(i, 6) 'Anlieferstelle
        .Cells(23, 8) = wks1.Cells(i, 7) 'Anzahl Teile1
        .Cells(21, 8) = wks1.Cells(i, 7) 'Anzahl Teile2
        .Cells(28, 5) = wks1.Cells(i, 8) 'Karte Nr.
        .Cells(28, 7) = wks1.Cells(i, 9) 'Anz Karten
        .Cells(17, 10) = wks1.Cells(i, 10) ' Regal
        .Cells(28, 3) = wks1.Cells(i, 11) ' LET
       
        .Cells(33, 1) = wks1.Cells(i, 2) ' IdentNr1
        .Cells(35, 2) = wks1.Cells(i, 2) ' IdentNr2
        .Cells(37, 2) = wks1.Cells(i, 2) ' IdentNr3
        .Cells(40, 2) = wks1.Cells(i, 3) ' Beschreibung
        .Cells(30, 1) = wks1.Cells(i, 4) ' L1
        .Cells(42, 9) = wks1.Cells(i, 4) ' L2
        .Cells(31, 2) = wks1.Cells(i, 5) ' KanbanBahnhof
        .Cells(31, 8) = wks1.Cells(i, 6) 'Anlieferstelle
        .Cells(37, 8) = wks1.Cells(i, 7) 'Anzahl Teile1
        .Cells(35, 8) = wks1.Cells(i, 7) 'Anzahl Teile2
        .Cells(42, 5) = wks1.Cells(i, 8) 'Karte Nr.
        .Cells(42, 7) = wks1.Cells(i, 9) 'Anz Karten
        .Cells(31, 10) = wks1.Cells(i, 10) ' Regal
        .Cells(42, 3) = wks1.Cells(i, 11) ' LET
       
        .Cells(47, 1) = wks1.Cells(i, 2) ' IdentNr1
        .Cells(49, 2) = wks1.Cells(i, 2) ' IdentNr2
        .Cells(51, 2) = wks1.Cells(i, 2) ' IdentNr3
        .Cells(54, 2) = wks1.Cells(i, 3) ' Beschreibung
        .Cells(44, 1) = wks1.Cells(i, 4) ' L1
        .Cells(56, 9) = wks1.Cells(i, 4) ' L2
        .Cells(45, 2) = wks1.Cells(i, 5) ' KanbanBahnhof
        .Cells(45, 8) = wks1.Cells(i, 6) 'Anlieferstelle
        .Cells(51, 8) = wks1.Cells(i, 7) 'Anzahl Teile1
        .Cells(49, 8) = wks1.Cells(i, 7) 'Anzahl Teile2
        .Cells(56, 5) = wks1.Cells(i, 8) 'Karte Nr.
        .Cells(56, 7) = wks1.Cells(i, 9) 'Anz Karten
        .Cells(45, 10) = wks1.Cells(i, 10) ' Regal
        .Cells(56, 3) = wks1.Cells(i, 11) ' LET
       
        Do Until i >= 1
           
        Loop
       
     End With
  Next i
 
End Sub

Leider funktioniert die Programmierung noch nicht ganz so wie ich mir vorstelle. Aktuell wird nämlich in eine Formularvorlage 4 mal der identische Datensatz eingefügt und dann in ein neues Formular wieder 4 mal der nächste Datensatz eingefügt, etc. :s
Ich hoffe ihr versteht mein Problem und ich wäre euch sehr dankbar, wenn mir jmd. weiterhelfen könnte.

Viele Grüße
Vicky

[BoskoBiati]

Hallo,

eine Mustertabelle hilft beim Helfen.

[RPP63]

Ging ihr nicht schnell genug, Edgar:
http://www.herber.de/forum/messages/1490786.html

@Vicky:
Ließ Dir bitte mal folgendes durch:
http://www.clever-excel-forum.de/Thread-Crossposting

Zum Thema:
Warum willst Du Dir die Datei unnötig aufblähen?
Da kommen doch zig Blätter zusammen, die nur eines sind: redundant!
Wenn es um einen Ausdruck geht:
Fülle das Formular stepweise mit Daten, drucke aus und auf ein Neues.

Gruß Ralf

[vicky]

@BoskoBiati
weil ich noch sehr neu hier bin, hab ich das irgendwie nicht gefunden mit dem hochladen. Vielen Dank für die Rückmeldung!

@Ralf
sorry ich bin ziemlich unerfahren was Foren angeht, wusste nicht ob ich überhaupt eine Rückmeldung bekomme und habe es daher vorsichtshalber mal in zwei reingestellt. Für mich zur Info: entspricht das nicht so dem Knigge, oder wieso der Kommentar? Wollte keinen Unmut stiften.
*hab mir den Link angeschaut* Danke!

Ich möchte die Datei natürlich nicht unnötig aufblähen. Wenn es eine bessere Lösung gibt, bin ich natürlich sehr daran interessiert.

[vicky]

@BoskoBiati
hier ist noch die Datei.

  Versuch 3.0.xlsm (Größe: 20,97 KB / Downloads: 6)
Vielleicht hat ja jmd. ein wenig Zeit mich zu unterstützen.

Vielen Dank!

[BoskoBiati]

Hallo Vicky,

1. kannst Du die fette Schrift ausschalten, das wirkt so bedrohlich.
2. Brauchst Du die Teilnehmer nicht persönlich ansprechen, wir lesen alle mit.

[BoskoBiati]

Hallo,

sollte passen:

Code:

Sub Makro1Versuch1()


Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim lngZ As Long, i As Long
Dim loSeite As Long
Dim loZeile As Long
Dim loZeile2 As Long
Set wks1 = Worksheets("Daten")
Set wks2 = Worksheets("Vorlage Makro")
lngZ = wks1.Cells(wks1.Rows.Count, 1).End(xlUp).Row
loende = Application.WorksheetFunction.RoundUp(lngZ / 4, 0)
For loSeite = 1 To loende
    wks2.Copy After:=Sheets(Sheets.Count)
    With ActiveSheet
        For i = 1 To 4
            loZeile = i + 1 + (loSeite - 1) * 4
            loZeile2 = (i - 1) * 14
            .Cells(5 + loZeile2, 1) = wks1.Cells(loZeile, 2) ' IdentNr1
            .Cells(7 + loZeile2, 2) = wks1.Cells(loZeile, 2) ' IdentNr2
            .Cells(9 + loZeile2, 2) = wks1.Cells(loZeile, 2) ' IdentNr3
            .Cells(12 + loZeile2, 2) = wks1.Cells(loZeile, 3) ' Beschreibung
            .Cells(2 + loZeile2, 1) = wks1.Cells(loZeile, 4) ' L1
            .Cells(14 + loZeile2, 9) = wks1.Cells(loZeile, 4) ' L2
            .Cells(3 + loZeile2, 2) = wks1.Cells(loZeile, 5) ' KanbanBahnhof
            .Cells(3 + loZeile2, 8) = wks1.Cells(loZeile, 6) 'Anlieferstelle
            .Cells(9 + loZeile2, 8) = wks1.Cells(loZeile, 7) 'Anzahl Teile1
            .Cells(7 + loZeile2, 8) = wks1.Cells(loZeile, 7) 'Anzahl Teile2
            .Cells(14 + loZeile2, 5) = wks1.Cells(loZeile, 8) 'Karte Nr.
            .Cells(14 + loZeile2, 7) = wks1.Cells(loZeile, 9) 'Anz Karten
            .Cells(3 + loZeile2, 10) = wks1.Cells(loZeile, 10) ' Regal
            .Cells(14 + loZeile2, 3) = wks1.Cells(loZeile, 11) ' LET
        Next i
    End With
Next
End Sub

[Kuwer]

Hallo Vicky,

das wäre mein Vorschlag:

Sub MakroVorschlagKuwer()

 Dim wks1 As Worksheet

 Dim wks2 As Worksheet

 Dim lngZ As Long, i As Long, j As Long

 Set wks1 = Worksheets("Daten")

 lngZ = wks1.Cells(wks1.Rows.Count, 1).End(xlUp).Row

 Set wks2 = Worksheets("Vorlage Makro")

 wks2.Copy After:=Sheets(Sheets.Count)

 j = 2 - 14

 For i = 2 To lngZ

   j = j + 14

   With ActiveSheet

     .Cells(j + 3, 1) = wks1.Cells(i, 2) ' IdentNr1

     .Cells(j + 5, 2) = wks1.Cells(i, 2) ' IdentNr2

     .Cells(j + 7, 2) = wks1.Cells(i, 2) ' IdentNr3

     .Cells(j + 10, 2) = wks1.Cells(i, 3) ' Beschreibung

     .Cells(j, 1) = wks1.Cells(i, 4) ' L1

     .Cells(j + 12, 9) = wks1.Cells(i, 4) ' L2

     .Cells(j + 1, 2) = wks1.Cells(i, 5) ' KanbanBahnhof

     .Cells(j + 1, 8) = wks1.Cells(i, 6) 'Anlieferstelle

     .Cells(j + 7, 8) = wks1.Cells(i, 7) 'Anzahl Teile1

     .Cells(j + 5, 8) = wks1.Cells(i, 7) 'Anzahl Teile2

     .Cells(j + 12, 5) = wks1.Cells(i, 8) 'Karte Nr.

     .Cells(j + 12, 7) = wks1.Cells(i, 9) 'Anz Karten

     .Cells(j + 1, 10) = wks1.Cells(i, 10) ' Regal

     .Cells(j + 12, 3) = wks1.Cells(i, 11) ' LET

   End With

 Next i

End Sub

Gruß Uwe

[BoskoBiati]

Hallo Uwe,


Dein Makro rattert zwar alles runter, aber eigentlich sollten nur vier Einträge auf eine Seite und dann eine neue Seite erstellt werden.

[vicky]

Wow, vielen vielen Dank für eure Antworten.
Das funktioniert beides prima.

Ich muss mir noch durch den Kopf gehen lassen, welche der beiden Lösungen für meine Anwendung besser geeignet ist.
Ich bedanke mich ganz ganz herzlich für eure Hilfe!!! :)