Bestimmte Zelle nach jedem Seitenumbruch

Hallo liebe Forumsmitglieder,
Situation: Ich habe eine Art Sammlung mit Ausgabebutton und Checkboxen, wähle ich mir bestimmte Teile aus und aktiviere den Button, dann werden die Inhalte aus den einzelnen Tabellen kopiert und auf den Worksheets("Ausgabe") übertragen.
Nun soll folgendes gelöst werden: Die bestimmte "Zelle" die sich 4 Reihen nach dem Seitenumbruch und in Spalte B befindet, ist immer gefüllt (mit der Überschrift). In die Zelle davor soll jetzt die "Nummerierung" eingetragen werden - "Aufgabenblock 1" auf Seite 1, "Aufgabenblock 2" auf Seite 2 ...
Ich versuche also jede Zelle an bestimmter Position in Worksheets("Ausgabe") zu bestimmen, zu prüfen ob etwas vorhanden ist und dann davor die Nummerierung zu schreiben.
Ich habe es bist jetzt dazu gebracht:
Er zählt hier automatisch zur dritten Zelle (nach dem dritten Seitenumbruch) und ersetzt diese durch den Wert 50 ... Ich doktore schon seit einiger Zeit an dem Code rum, komme aber nicht auf die Lösung...
Dim Zelle As Range
Dim zelle2 As Range
Dim pagebreakrow As Long
Dim pagebreakcol As Long
Dim i As Integer
Dim b As Integer
With Worksheets("Ausgabe")
For b = 0 To 2
pagebreakrow = .HPageBreaks(1 + b).Location.Row
Set Zelle = .Cells(pagebreakrow, 2).Offset(4, 0)
Set zelle2 = .Cells(pagebreakrow, 2).Offset(4, 0)
Next b
For Each Zelle In Range("A1:B218")
'Hier soll eig. Worksheets("Ausgabe") hin, aber bei zwei Variablen/Objekten meckert er immer. Die Range ist nämlich auch nicht genau anzugeben. Deswegen soll die ganze Tabelle durchsucht werden.
For i = 2 To 50
If Zelle "" Then
zelle2.Value = i 'Hier soll eig "Aufgabenblock i" stehen, also das Wort und die hochzählende Zahl
End If
Next i
Next Zelle
End With
End Sub
Kann es überhaupt so funktionieren?
Kann ich in einer for each Schleife Zellen auf einem bestimmten Arbeitsblatt ansteuern ohne eine Range vorzugeben?
Kann mir jemand eine Tipp geben, wie ich auf die Lösung komme oder bin ich hier komplett auf dem Holzweg? Mir fällt aktuell auch keine alternative zum Nummerieren ein. (Jedenfalls nicht in diesem Projekt:))
Danke!
MfG Sascha

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub EinfuegenAufgabenBereich() Dim wks As Worksheet Dim objHPagebreak As HPageBreak Dim Zelle As Range, iAufgabe As Integer Set wks = Worksheets("Ausgabe") iAufgabe = 0 'Zähler zurücksetzen auf 0 With wks 'Seite 1 prüfen Set Zelle = .Cells(4, 2) 'Zeile 4, Spalte B prüfen If Zelle "" Then iAufgabe = iAufgabe + 1 Zelle.Offset(-1, 0).Value = "Aufgabenblock " & iAufgabe End If 'Alle horizontalen Seitenwechsel abarbeiten For Each objHPagebreak In .HPageBreaks Set Zelle = .Cells(objHPagebreak.Location.Row + 3, 2) 'Zelle mit Überschrift If Zelle "" Then iAufgabe = iAufgabe + 1 Zelle.Offset(-1, 0).Value = "Aufgabenblock " & iAufgabe End If Next End With End Sub

Sub EinfuegenAufgabenBereich() Dim wks As Worksheet Dim objHPagebreak As HPageBreak Dim Zelle As Range, iAufgabe As Integer Set wks = ActiveWorkbook.Worksheets("Ausgabe") iAufgabe = 0 'Zähler zurücksetzen auf 0 With wks .Activate .Range("A1").Select 'Seite 1 prüfen Set Zelle = .Cells(5, 2) 'Zeile 4, Spalte B prüfen If IsEmpty(Zelle) Then 'then do nothing ElseIf Zelle "" Then iAufgabe = iAufgabe + 1 Zelle.Offset(-1, 0).Value = "Aufgabenblock " & iAufgabe End If 'Alle horizontalen Seitenwechsel abarbeiten For Each objHPagebreak In .HPageBreaks Set Zelle = .Cells(objHPagebreak.Location.Row + 4, 2) 'Zelle mit Überschrift If IsEmpty(Zelle) Then 'then do nothing ElseIf Zelle "" Then iAufgabe = iAufgabe + 1 Zelle.Offset(-1, 0).Value = "Aufgabenblock " & iAufgabe End If Next End With End Sub

Sub Loeschen() If Range("B7").Value = True Then 'mit B7 ist eine Checkbox verbunden Worksheets("3. xxx").Rows("58:116").Copy 'Die Rows geben die einzelnen Seiten vor Worksheets("Ausgabe").Rows(1).Insert Shift:=xlDown End If If Range("B6").Value = True Then Worksheets("2. xxx").Rows("1:52").Copy Worksheets("Ausgabe").Rows(1).Insert Shift:=xlDown End If End Sub

Hallo Sascha,
nach dem Kopieren werden scheinbar die Seitenumbrüche im Blatt "Ausgabe" nicht oder nicht schnell genug neu berechnet/aktualisiert.
Ich hab jetzt das Scrollen in das Makro eingebaut. Danach funktionierts ohne Fehler.
Gruß
Franz

Sub EinfuegenAufgabenBereich()
Dim wks As Worksheet
Dim objHPagebreak As HPageBreak
Dim Zelle As Range, iAufgabe As Integer
Set wks = ActiveWorkbook.Worksheets("Ausgabe")
iAufgabe = 0 'Zähler zurücksetzen auf 0
With wks
.Activate
.Range("A1").Select
Application.ScreenUpdating = True
Set Zelle = .Cells.SpecialCells(xlCellTypeLastCell)
ActiveWindow.ScrollRow = Zelle.Row + 1
ActiveWindow.ScrollRow = 1
'Seite 1 prüfen
Set Zelle = .Cells(5, 2) 'Zeile 4, Spalte B prüfen
If IsEmpty(Zelle) Then
'then do nothing
ElseIf Zelle  "" Then
iAufgabe = iAufgabe + 1
Zelle.Offset(-1, 0).Value = "Aufgabenblock " & iAufgabe
End If
'Alle horizontalen Seitenwechsel abarbeiten
For Each objHPagebreak In .HPageBreaks
Set Zelle = .Cells(objHPagebreak.Location.Row + 4, 2) 'Zelle mit Überschrift
If IsEmpty(Zelle) Then
'then do nothing
ElseIf Zelle  "" Then
iAufgabe = iAufgabe + 1
Zelle.Offset(-1, 0).Value = "Aufgabenblock " & iAufgabe
End If
Next
End With
End Sub

Deine anderen Makros würde ich wie folgt ändern. Dabei wird dann vor jedem kopierten Satz Zeilen ein manueller horizontaler Seitenumbruch eingefügt. Das kannst du aber auch weglassen

'Diese Code-Zeile ganz oben im Modul mit den Makros
Private bolUmbruch As Boolean 'Merker für Einfügen eines Seitenumbruchs
Sub AusgabeLöschen()
With Sheets("Ausgabe")
.Pictures.Delete
.UsedRange.EntireRow.Delete Shift:=xlUp
End With
End Sub
Sub Loeschen()
bolUmbruch = False
If Range("B7").Value = True Then prcCopy Worksheets("3. xxx").Rows("58:116")
If Range("B6").Value = True Then prcCopy Worksheets("2. xxx").Rows("1:52")
Application.CutCopyMode = False
Call EinfuegenAufgabenBereich
End Sub
Sub prcCopy(rngBereich As Range)
Dim wksAusgabe As Worksheet, Zeilen As Long
Set wksAusgabe = Worksheets("Ausgabe")
With rngBereich
.Copy
Zeilen = .Rows.Count
End With
wksAusgabe.Rows(1).Insert Shift:=xlDown
'außer beim 1. mal nach den eingefügten Zeilen einen manuellen Seitenumbruch setzen
If bolUmbruch Then
wksAusgabe.HPageBreaks.Add wksAusgabe.Cells(Zeilen + 1, 1)
Else
bolUmbruch = True
End If
End Sub

Beliebteste Forumthreads (12 Monate)

Bestimmte Zelle nach jedem Seitenumbruch

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Bestimmte Zelle nach jedem Seitenumbruch

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread