Zellen kopieren mit Wenn-Bedingung und drucken

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Lars,
hier mein Vorschlag.
Ich musste mein betagtes Ecxel 97 erst überreden, die InputBox mit Zellauswahl zu akzeptieren.
Ablauf:
1. du wählst die Spalte mit den x aus.
2. Wenn die InputBox angezeigt wird, dann Spalte mit Namen auswählen und OK
3. Blatt drucken wird angezeigt und mit Klick auf Ja wird gedruckt.
Gruß
Franz


Sub DruckSpecial()
Dim objWks As Worksheet, objWksDruck As Worksheet
Dim lngZeile As Long, LngZeileD As Long, objName As Range
Dim lngSpalteName As Long
Dim lngSpalteX As Long
On Error GoTo Fehler
Set objWks = ActiveSheet
Set objWksDruck = Worksheets("Drucken")
If ActiveSheet.Name = objWksDruck.Name Then
MsgBox "Diese Makro nicht im Blatt ""Drucken"" anwenden!"
GoTo Beenden
End If
lngSpalteX = ActiveCell.Column
Set objName = Application.InputBox(prompt:="Bitte Zelle in Spalte mit Name wählen" _
& vbLf & "oder Zelladresse eingebn (z.B. f1)", _
Title:="Daten Drucken - Ausdruck vorbereiten", Type:=8)
lngSpalteName = objName.Column
With objWks
'Alle Daten im Blatt Drucken löschen
objWksDruck.Cells.ClearContents
LngZeileD = 1
objWksDruck.Cells(LngZeileD, 3) = .Cells(1, lngSpalteName).Value 'name
For lngZeile = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
If LCase(.Cells(lngZeile, lngSpalteX).Value) = "x" Then
LngZeileD = LngZeileD + 1
objWksDruck.Cells(LngZeileD, 1) = .Cells(lngZeile, 1).Value 'Spalte A
objWksDruck.Cells(LngZeileD, 2) = .Cells(lngZeile, lngSpalteX).Value 'Spalte mit x
objWksDruck.Cells(LngZeileD, 3) = .Cells(lngZeile, lngSpalteName).Value 'Wert
End If
Next
End With
With objWksDruck
.Activate
If MsgBox("Blatt drucken?", vbQuestion + vbOKCancel, "Blatt Drucken") = vbOK Then
.PrintOut
'      .PrintPreview 'zum Testen
End If
End With
GoTo Beenden
Fehler:
If Err.Number  424 Then '424 = Objekt fehlt, in Inputboxwurde keine Zelle gewählt
MsgBox Err.Number & vbLf & Err.Description
End If
Beenden:
Set objWks = Nothing: Set objWksDruck = Nothing: Set objName = Nothing
End Sub

Hi Franz.
Nochmal vielen Dank für deine grandiose Hilfe! Das Problem ist, dass ich zu erst nur die Datei so erstellt hab, wie ich mir gedacht habe, dass ich sie bekomme. Nun kommen aber nach und nach Updates von Kollegen und daher ändert sich ab und an was...Ich habe aber nun um eine finale Version vom Design her, denke ich und da ist noch ein Problem.
Alles funktioniert super aber nur wenn die Spalte mit den x auch die Spalte B ist. Also direkt hinter den Schulungen kommt. Nun habe ich dort aber noch zusätzliche Spalten mit x in der Datei incl Mitarbeitern, die dazu gehören. Das ganze ist so aufgebaut, dass ein Sheet einen Bereich darstellt und da dann Abteilungen sind (wie z.B. Service oder Manager).
Hier mal was ich meine. https://www.herber.de/bbs/user/52463.xls Ich habe probiert Service zu drucken und das Ergebnis siehst du. Wenn man die Spalte Effective Date löscht, dann funktioniert es einwandfrei! Aber dann kann ich nicht Trainer drucken. Dann ist das selbe Problem wie zur Zeit mit Service, weil die entsprechende Spalte mit den x nicht vorne steht.
Wenn das noch funktioniert, denke ich, dass ich nicht weiter nerven werde und du hättest einen Kasten Bier verdient! ^^
MfG Lars

Beliebteste Forumthreads (12 Monate)

Zellen kopieren mit Wenn-Bedingung und drucken

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Zellen kopieren mit Wenn-Bedingung und drucken

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

315 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread