Schleife in Makro

[Basty]

Hallo zusammen,

ich benötige bitte Unterstützung bei meinem Code.

Das ganze ist egtl. recht simpel. Der Makro soll Personendaten aus einer Tabelle in ein Berechnungstool einfügen und dann die Ergbenisseiten drucken + das ganze unter einem neuen Namen speichern.
Es handelt sich um Daten von mehreren 100 Personen, je Zeile eine Person.

Hier mein Code:

---------
Private Sub CommandButton1_Click()

Dim DateiName As String
Dim path As String
DateiName = Worksheets("Makros").Range("A1").Value
path = ActiveWorkbook.path + DateiName

'Name

Sheets("40 b FINAL").Range("A2").Copy
Sheets("Eingaben").Range("D5").PasteSpecial xlPasteValues

'Geburtsdatum

Sheets("40 b FINAL").Range("C2").Copy
Sheets("Eingaben").Range("D7").PasteSpecial xlPasteValues

Sheets("40 b FINAL").Range("D2").Copy
Sheets("Eingaben").Range("E7").PasteSpecial xlPasteValues

Sheets("40 b FINAL").Range("E2").Copy
Sheets("Eingaben").Range("F7").PasteSpecial xlPasteValues

'Diensteintrittsdatum

Sheets("40 b FINAL").Range("G2").Copy
Sheets("Eingaben").Range("D11").PasteSpecial xlPasteValues

Sheets("40 b FINAL").Range("H2").Copy
Sheets("Eingaben").Range("E11").PasteSpecial xlPasteValues

Sheets("40 b FINAL").Range("I2").Copy
Sheets("Eingaben").Range("F11").PasteSpecial xlPasteValues

' speichern
ActiveWorkbook.SaveAs path

'drucken
Sheets("Eingaben").PrintOut
Sheets("Steuerliche Auswirkungen").PrintOut

End Sub

------------

Es funktioniert auch. Nun komme ich jedoch nicht drauf, wie ich eine vernünftigte Schleife einbaue. Das Makro soll diesen Vorgang im Prinzip direkt wiederholen, für die Person deren Daten in der Zeile darunter (also in Zeile 3) stehen. Und dann immer wieder, bis es auf eine Zeile stößt, deren erste Zelle leer ist. Dann soll der Prozess enden.

Kann mir jemand helfen? Wahrscheinlich ist die Lösung recht unkompliziert...

Achja, und es gibt noch das Problem, dass er die Datei zwar unter neuem Namen speichert, aber dann auch die Ursprungsdatei schließt. Egtl soll es so aussehen, dass er es unter einem neuen Namen speichert, jedoch diese Datei dann nicht öffnet. Ist das auch machbar?

Danke im Voraus!

[Kuwer]

Hallo Basty,

vielleicht so:

Private Sub CommandButton1_Click()

 Dim i As Long

 ActiveCell.Activate

 With Sheets("40 b FINAL")

   For i = 2 To Cells(.Rows.Count, 1).End(xlUp).Row

     'Name

     Sheets("Eingaben").Range("D5").Value = .Cells(i, 1).Value

     'Geburtsdatum

     Sheets("Eingaben").Range("D7:F7").Value = .Cells(i, 3).Resize(1, 3).Value

     'Diensteintrittsdatum

     Sheets("Eingaben").Range("D11:F11").Value = .Cells(i, 7).Resize(1, 3).Value

     'drucken

     Sheets("Eingaben").PrintOut

     Sheets("Steuerliche Auswirkungen").PrintOut

     'speichern

     ThisWorkbook.SaveCopyAs ThisWorkbook.path & "\" & Worksheets("Makros").Cells(i - 1, 1).Value

   Next i

 End With

End Sub

Code eingefügt mit: Excel Code Jeanie


Gruß Uwe

[RPP63]

Moin Uwe!
Nur eine Verständnisfrage:
Hat es einen Grund, warum Du .Resize und nicht einfach .Copy benutzt?
Ich persönlich verwende .Resize eher, wenn ich etwas errechnen lassen muss.
Eher seltener, wenn ich die Parameter selbst errechnen muss.

Aber - wie gesagt - nur eine Verständnisfrage.

Gruß Ralf

[Kuwer]

Hat es einen Grund, warum Du .Resize und nicht einfach .Copy benutzt?

weil Value gefordert war!?

Gruß Uwe

[RPP63]

Wäre eine Erklärung!  :05:
(und Nein! ich werde nicht um die Nanosekunden des .PasteSpecial feilschen)

Gruß Ralf

[Kuwer]

Wäre eine Erklärung!  :05:
(und Nein! ich werde nicht um die Nanosekunden des .PasteSpecial feilschen)

Da bin ich ja  jetzt richtig erleichtert.  :94:

Gruß Uwe

[schauan]

Hallöchen,

http://www.clever-excel-forum.de/Thread-...2#pid94162
wobei das nur die Halbe Miete ist, man kann auch einen größeren Bereich verkleinern

Sub test_resize()
MsgBox Range("A1").Resize(2, 2).Address 'wird A1:B2
MsgBox Range("A1:C3").Resize(2, 2).Address 'wird auch A1:B2
End Sub

wobei das zweite Beispiel eher selten Sinn macht, es würde ja die Angabe Range("A1") reichen. Aber vielleicht braucht mal wer so was:
MsgBox Range("A1:C3").Cells(2).Resize(2, 2).Address