Guten Tag,
ich bin VBA-Neuling und stehe vor folgendem Problem:
Bestimmte untereinanderstehende Daten aus einer Excelliste (keine Tabelle) sollen nacheinander und automatisch in ein Zielformular (selbe Arbeitsmappe) kopiert werden. Nach dem Kopieren öffnet sich die Druckansicht, nach dem Drucken od. ggf. Druckabbruch leeren sich die Zellen des Zielformulars. Dies geschieht derzeit aber nur mit dem ersten Datensatz "001". An der Schleife verzweifle ich derzeit.
Die Daten in der Liste sind wie folgt aufgebaut:
001 (A4), NameVorname (B4), Firma (C4), ausgestellt am (D4), gültig bis (E4)...
002 (A5), (B5), (C5), (D5)...
zu kopieren sind die Daten in den Spalten lfdNummer(A), NameVorname(B) und gültig bis (E)
Die Schleife soll alle o.g. Schritte durchspielen lassen, bis Spalte (B) NameVorname leer ist. Muss die Range noch angepasst werden? Danke im Voraus
Die Prozedur:
Sub Datentübertragung()
On Error GoTo 0
Dim NameVorname As String
Dim wksQuelle As Worksheet
Dim wksZiel As Worksheet
Dim safety As Long
'Set wksQuelle = Worksheets("ListeEinfahrgenehmigung")
'Set wksZiel = Worksheets("FormularPersonengebunden")
'
' Kopiert lfd Nummer von ListeEinfahrgenehmigung in Zielformular FormularPersonengebunden
'
Sheets("ListeEinfahrgenehmigung").Select
Range("A4").Select
Selection.Copy
Sheets("FormularPersonengebunden").Select
Range("C3:D3").Select
ActiveSheet.Paste
'
' Kopiert Name, Vorname von Liste Einfahrgenehmigung in Zielformular
'
Sheets("ListeEinfahrgenehmigung").Select
Range("B4").Select
Selection.Copy
Sheets("FormularPersonengebunden").Select
Range("B7:D8").Select
ActiveSheet.Paste
'
' Kopiert Datum "gültig bis" von Liste Einfahrgenehmigung in Zielformular
'
Sheets("ListeEinfahrgenehmigung").Select
Range("E4").Select
Selection.Copy
Sheets("FormularPersonengebunden").Select
Range("B10:B12").Select
ActiveSheet.Paste
'
' Öffnet Druckansicht
'
Sheets("FormularPersonengebunden").Activate
With ActiveSheet
.PrintPreview
End With
'
' Löscht Daten aus Zielformular
'
Sheets("FormularPersonengebunden").Select
Range("C3:D3").Select
Selection.ClearContents
Range("B7:D8").Select
Selection.ClearContents
Range("B10:B12").Select
Selection.ClearContents
End Sub
|