Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
348to352
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
348to352
348to352
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Leere Zellen und Druckbereich

Leere Zellen und Druckbereich
14.12.2003 15:51:27
Tobi
Moin,

habe Excel mit dem unten stehenden Code dazu gebracht mir nur die Zellen zu makieren ,die einen Wert mit "R" (in Spalte u) enthalten, die werden dann auch als Druckbereich übernommen.
Problem ist nur wenn die Zellen nicht zusammenhängen (leere Spalten oder leere Zeilen dazwischen) wird für den nächsten Wert ein neues Blatt angelegt.
Ich habe also auf einem Blatt 5 Excel Zeilen, auf dem nächsten 3, dann 6 usw. normalerweise müsste alles auf ein Blatt passen.


*CODE*


Sub Druck
Dim k As Long
Dim a As String
Dim p As String
Set f = Selection
For k = 1 To 548
Cells(k, u).Select                              'u ist eine globale Variable
a = ActiveCell.Value
If a Like "*R*" Then
Union(f, Cells(k, 2), Cells(k, u)).Select
Set f = Selection
End If
Next k
p = Selection.Address
ActiveSheet.PageSetup.PrintArea = p
End Sub


Vielleicht kann mir ja jemand weiterhelfen, das für den Druckbereich die leeren Zellen ignoriert werden

Bin für jeden Denkanstoss dankbar.

Tobi

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
Das ist leider nicht möglich.
14.12.2003 18:05:28
Ramses
Hallo

Der Druckbereich MUSS immer zusammenhängend sein.
Es ist nicht möglich Leerzeilen im von dir definierten Druckbereich auszuklammern.

Gruss Rainer
AW: Leere Zellen und Druckbereich
14.12.2003 20:00:56
Reinhard
Hi Tobi,
probier mal das Makro, es sammelt die Zellen mit *r* zusammen und schreibt sie, mit Leerzeile getrennt, in Spalte A von Blatt Tabelle2.
Wenn du auch diese eine Leerzeile weghaben willst, in der viertletzten Zeile hinten die 2 durch 1 ersetzen.
Gruß
Reinhard

Sub Druck()
Dim k As Long
Dim Bereich As Range
Dim f As Range
Dim Zeile As Long
Dim u As Long
Set WS1 = Worksheets("Tabelle1")
Set WS2 = Worksheets("Tabelle2")
u = 1
With WS1
For k = 1 To 548
If Cells(k, u).Value Like "*r*" Then
If Not f Is Nothing Then
Set f = Application.Union(f, Cells(k, u))
Else
Set f = Cells(k, u)
End If
End If
Next k
End With
' hier ggfs noch Fehler abfangen wenn es keine Zellen mit *r* gab
WS2.Range("A1:A65536").ClearContents
Zeile = 1
For Each Bereich In WS1.Range(f.Address).Areas
Bereich.Copy WS2.Cells(Zeile, 1)
Zeile = WS2.[A65536].End(xlUp).Row + 2
Next Bereich
WS2.PageSetup.PrintArea = "$A$1:$a$" & WS2.[A65536].End(xlUp).Row
End Sub

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige