AW: Excel, Makro-Schleife mit Zählen
14.11.2014 17:05:11
fcs
Hallo Winni,
grundsätzlich kann man es mit Makros der folgenden Struktur lösen.
Hier muss man ggf. im Hauptmakro die Namen der Tabellen und die Startzeile festlegen.
Für Varianten kann man das Hauptmakro kopieren und unterschiedliche Namen für das Blatt mit der Liste vorgeben.
Sieht die Druckausgabe anders aus, dann muss man das Übertragungsmakro anpassen oder eine Kopie des Makros anpassen und den Makronamen im Hauptmakro anpassen.
Gruß
Franz
'Code in einem allgemeinen Modul
Option Explicit
Private wksListe As Worksheet, wksDruck As Worksheet, ZeileL As Long, bolFehler As Boolean
Public Sub DruckenTabelle1()
Set wksListe = ActiveWorkbook.Worksheets("Tabelle1") 'Tabellenblatt mit Liste
Set wksDruck = ActiveWorkbook.Worksheets("Tabelle2") 'Tabellenblatt für Druckausgabe
Call prcDruckenAuswahl(strMakro:="fncDaten_nach_Tab2", Zeile_1:=2, _
bolPreview:=False, ColumnLastRow:=1)
Set wksListe = Nothing
Set wksDruck = Nothing
End Sub
Sub prcDruckenAuswahl(strMakro As String, Optional Zeile_1 As Long = 2, _
Optional bolPreview As Boolean = False, _
Optional ColumnLastRow As Long = 1)
Dim Zeile_Letzte As Long
'strMakro = Name des Makros, das die Daten aus der Liste in die Drucktabelle überträgt.
'Zeile_1 = 1. Datenzeile der Datenliste
'bolPreview = wenn True dann wird die Druckvorschau angezeigt
'ColumnLastRow = letzte Zeile mit Daten wird in Spalte ermittelt _
wenn 0, dann wird letzte benutzte Zeile aus UsedRange ermittelt
If ColumnLastRow =0 sein!"
Exit Sub
End If
If Zeile_1 =1 sein!"
Exit Sub
End If
If MsgBox("Sichtbare Datenzeilen in Blatt """ & wksListe.Name _
& """ nach Blatt """ & wksDruck.Name _
& """ übertragen und drucken", _
vbOKCancel + vbQuestion, "Seriendruck-Makro: " & strMakro) = vbCancel Then Exit Sub
With wksListe
If ColumnLastRow = 0 Then
Zeile_Letzte = .UsedRange.Row + .UsedRange.Rows.Count - 1
Else
Zeile_Letzte = .Cells(.Rows.Count, ColumnLastRow).End(xlUp).Row
End If
If Zeile_Letzte >= Zeile_1 Then
For ZeileL = Zeile_1 To Zeile_Letzte
If .Rows(ZeileL).Hidden = False Then
Run strMakro
If bolFehler = False Then
If bolPreview = True Then
wksDruck.PrintPreview
Else
wksDruck.PrintOut
End If
End If
End If
Next
Else
MsgBox "Keine Daten in Liste """ & wksListe.Name & """"
End If
End With
End Sub
Private Sub fncDaten_nach_Tab2()
bolFehler = True
On Error GoTo Fehler
'Übertragen der Daten aus der Zeile der Quelletabelle in das Ziel Tabelle1
With wksListe
If .Cells(ZeileL, 1) = "" Then bolFehler = True: Exit Sub
wksDruck.Cells(2, 3).Value = .Cells(ZeileL, 2).Text & " " & .Cells(ZeileL, 1).Text 'Vorname _
Name
wksDruck.Cells(4, 3).Value = "'" & .Cells(ZeileL, 4).Value 'PLZ
wksDruck.Cells(4, 4).Value = "'" & .Cells(ZeileL, 3).Value 'Ort
wksDruck.Cells(4, 6).Value = .Cells(ZeileL, 5).Value 'Datum
wksDruck.Cells(6, 3).Value = .Cells(ZeileL, 6).Value 'Wert 1
wksDruck.Range("E6").Value = .Cells(ZeileL, 7).Text 'Info
End With
bolFehler = False
Fehler:
With Err
Select Case .Number
Case 0 'alles ist ok
Case Else
MsgBox "Fehler-Nr.: " & .Number & .Description, _
vbInformation + vbOKOnly, "Übertragen der Daten aus Zeile " & ZeileL
End Select
End With
End Sub