AW: Liste in Excel als Serienbrief drucken
KLE
Ich habe den Code noch etwas angepasst, da ich nur bestimmte Datensätze ausdrucken lassen möchte, welche einem Suchkriterium entsprechen...für den Fall der Fälle stelle ich diesen hier gern zur weiteren Verwendung, Anmerkung, Optimierung etc. zur Verfügung !
Gruß und Danke an Euch alle - Ihr seid echt Helden (Helfer in der Not !)
Kay
Sub DatenSerienDruck()
Dim wksDruck As Worksheet
Dim wksFilter As Worksheet
Dim lngZeile As Long
Dim Index As String
Dim iRow As Long
Dim Suchfeld As String
Application.ScreenUpdating = False
Const lngZeile1 As Long = 2 ' 1. datenzeile im _
Auswahlblatt
Set wksDruck = Worksheets("Druck") ' Blatt für Seriendruck
Set wksFilter = Worksheets("Daten") ' Blatt mit Auswahldaten
Suchfeld = Sheets("Erfassung").Range("T4").Value ' Filterkriterium
iRow = 2 ' Startzeile der _
Datenliste
With wksFilter
For lngZeile = lngZeile1 To .Cells(.Rows.Count, 1).End(xlUp).Row
If Sheets("Erfassung").Range("AN5").Value = 1 Then
Index = Sheets("Daten").Range("H" & iRow).Value ' Spalte H = KdVor- & Zuname als _
Suchindex
Else
If Sheets("Erfassung").Range("AN5").Value = 2 Then
Index = Sheets("Daten").Range("I" & iRow).Value ' Spalte I = KdName als Suchindex
Else
If Sheets("Erfassung").Range("AN5").Value = 3 Then
Index = Sheets("Daten").Range("K" & iRow).Value ' Spalte K = KdVorname als Suchindex
Else
If Sheets("Erfassung").Range("AN5").Value = 4 Then
Index = Sheets("Daten").Range("L" & iRow).Value ' Spalte L = FilialNr. (SID) als _
Suchindex
Else
If Sheets("Erfassung").Range("AN5").Value = 5 Then
Index = Sheets("Daten").Range("M" & iRow).Value ' Spalte M = RegNr. als Suchindex
Else
If Sheets("Erfassung").Range("AN5").Value = 6 Then
Index = Sheets("Daten").Range("E" & iRow).Value ' Spalte E = VorfallNr als Suchindex
Else
If Sheets("Erfassung").Range("AN5").Value = 7 Then
Index = Sheets("Daten").Range("Y" & iRow).Value ' Spalte Y = MA-Name als Suchindex
Else
If Sheets("Erfassung").Range("AN5").Value = 8 Then
Index = Sheets("Daten").Range("Z" & iRow).Value ' Spalte Z = MA-ID als Suchindex
Else
If Sheets("Erfassung").Range("AN5").Value = 9 Then
Index = Sheets("Daten").Range("C" & iRow).Value ' Spalte C = Kundenname als _
Suchindex
Else
If Sheets("Erfassung").Range("AN5").Value = 10 Then
Index = Sheets("Daten").Range("D" & iRow).Value ' Spalte D = SID-Reg als Suchindex/ _
nicht Benutzer
End If
End If
End If
End If
End If
End If
End If
End If
End If
End If
If Index = Suchfeld Then
'Daten aus Zeile ins Druckblatt übertragen
wksDruck.Range("D3").Value = .Cells(lngZeile, 2).Value 'Datensatz
wksDruck.Range("D5").Value = .Cells(lngZeile, 5).Value 'VorafllNr.
wksDruck.Range("D6").Value = .Cells(lngZeile, 6).Value 'Datum
wksDruck.Range("D8").Value = .Cells(lngZeile, 7).Value 'Anrede
wksDruck.Range("D9").Value = .Cells(lngZeile, 8).Value 'Vorname
wksDruck.Range("D10").Value = .Cells(lngZeile, 9).Value 'Nachname
wksDruck.Range("D11").Value = .Cells(lngZeile, 10).Value 'PLZ5
wksDruck.Range("D13").Value = .Cells(lngZeile, 11).Value 'VK-Datum
wksDruck.Range("D14").Value = .Cells(lngZeile, 12).Value 'SID
wksDruck.Range("D15").Value = .Cells(lngZeile, 13).Value 'RegNr
wksDruck.Range("D17").Value = .Cells(lngZeile, 14).Value 'ArtikelNr
wksDruck.Range("D18").Value = .Cells(lngZeile, 15).Value 'Artikelname
wksDruck.Range("D19").Value = .Cells(lngZeile, 16).Value 'SerienNr.1
wksDruck.Range("D21").Value = .Cells(lngZeile, 17).Value 'ArtikelNr.2
wksDruck.Range("D22").Value = .Cells(lngZeile, 18).Value 'Artikelname2
wksDruck.Range("D23").Value = .Cells(lngZeile, 19).Value 'SN 2
wksDruck.Range("D24").Value = .Cells(lngZeile, 20).Value 'WG
wksDruck.Range("D26").Value = .Cells(lngZeile, 21).Value 'WUG
wksDruck.Range("D28").Value = .Cells(lngZeile, 22).Value 'DBProv
wksDruck.Range("D29").Value = .Cells(lngZeile, 23).Value 'ProvWG
wksDruck.Range("D30").Value = .Cells(lngZeile, 24).Value 'MAProv
wksDruck.Range("D31").Value = .Cells(lngZeile, 27).Value 'VK netto
wksDruck.Range("D32").Value = .Cells(lngZeile, 28).Value 'Endbetrag
wksDruck.Range("D34").Value = .Cells(lngZeile, 25).Value 'MA-Name
wksDruck.Range("D35").Value = .Cells(lngZeile, 26).Value 'MA PID
wksDruck.Range("D37").Value = .Cells(lngZeile, 29).Value 'Bemerkung
wksDruck.Range("D40").Value = .Cells(lngZeile, 30).Value 'letzte Änderung
wksDruck.Range("D41").Value = .Cells(lngZeile, 31).Value 'Änderung durch KZ
wksDruck.PrintOut 'Preview:=True
End If
iRow = iRow + 1
Zähler = Zähler + 1
Next
End With
Application.ScreenUpdating = True
End Sub