Marko Code um Zellen erweitern ?!

[sfina]

Ok.. klappt leider doch nicht.
Mal ein anderer Ansatz

Ich habe z.B 10747 Zellen
Jetzt soll das Makro alle leeren Zellen finden und selbstständig mit einem manuellen Seitenumbruch versehen.
Ich habe die große Datei auf 4 aufgeteilt. Jetzt wären es also je Datei unter 1000 Seitenumbrüche.
Der Erste Ansatz von mir klappte nicht, da Excel die gesetzten S.umbrüche dann nicht mit sortiert. Die bleiben stur an ihrem Platz :)

PS Die Methode von Klaus-Dieter kann ich nicht verwenden.

[schauan]

Hallöchen,

Seitenumbrüche werden auch nicht mit sortiert. Beim Sortieren hast Du ja ggf. auch die leeren Zeilen alle unten und nicht mehr zwischen den Bereichen.

Das mit dem Filtern wurde Dir ja schon vorgeschlagen.
Eine "Hilfskrücke" wäre, wenn Du die Zeilen nummerierst. Du könntest z.B. eine fünf- oder mehrstellige Nummer generieren, bestehend aus Blatt und Zeile. Da nimmst Du aber jede Zeilennummer, auch wenn die ansonsten leer wäre. Ob Du da mit 101 anfängst für Blatt1, Zeile1, oder mit 1000101, damit Du immer gleich lange Zahlen hast wegen der fehlenden führenden Nullen, sei mal dahingestellt.
Irgendwo führst Du dann auch noch eine Nummer für den Gliederungsbereich - oder stellst die vorne dran, dann also 1011000101 Die 101 steht wieder für gleichlange Zahlen - 001 hätte ggf. wieder keine führenden Nullen. Du kannst die Zahlen auch auf 3 Spalten aufteilen, wie auch immer Du besser damit zurecht kommst. Da kannst Du dann z.B. einen Gliederungsbereich filtern und in dem Bereich sortieren - Die Zahlen aber vielleicht nicht mit, sonst stehen die ganz schön durcheinander

[HKindler]

PS Die Methode von Klaus-Dieter kann ich nicht verwenden.

Mit Sicherheit nicht bei deinem jetzigen Aufbau. Zeig doch mal eine Beispieldatei und dir kann geholfen werden. Und zwar so, dass der Umgang mit den Daten wesentlich einfacher ist, als du dir das gerade vorstellen kannst.

Deine bisherige Beschreibung sieht mir sehr nach dem Denken in Papier aus. Das ist nicht gut für effiziente Datenverarbeitung.

[Gast 123]

Hallo

ich verstehe den ganzen Aufwand mit Seitenumbruch festlegen nicht.
Den Druckbereich festlegen geht doch viel einfacher, mit einem simplen Makro.

Die Artikelnummer kann man per InputBox ermitteln, oder aus einer Zelle laden!
Mein Suchlauf ist in Spalte "C", muss zusammen mit After:=[c1] angepasst werden.
Als Anf-Adresse habe ich "A", ggf ändern! Und die Endspalte muss eingefügt werden.
Damit sollte die Zuweisung des Print Bereich klappen.

Alternativ könnte man in jeder Leerzeile einen Gruppen Namen angeben. Nach Gruppe suchen.
Das erfordert aber 3000 Namen von Hand in die Tabelle eintragen!  Viiiiel Arbeit!!
Für den Fall gibt es den zweiten Code, der ist einfacher weil KEINE Adress Korrektur nötig!

mfg Gast 123

Code:

Sub GruppenBereich_festlegen()
Dim rFind As Range, AnfAdr, EndAdr
Dim Eingabe As Variant
Eingabe = InputBox("Bitte Artikel Nummer eingeben")
If Eingabe = Empty Then Exit Sub

   Set rFind = Columns("C").Find(What:=Eingabe, After:=[c1], LookIn:=xlFormulas, _
       LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
       
   If Not rFind Is Nothing Then
      'Anf-Adresse und End-Adresse über xlUp + xlDown
      AnfAdr = Cells(rFind.Row, "A").End(xlUp).Address
      EndAdr = Cells(rFind.Row, "xx").End(xlDown).Address
      'Adress Korrektur wenn oben/unten Leerzeile ist
      If rFind.Offset(-1, 0) = Empty Then _
         AnfAdr = Cells(rFind.Row, "A").Address
      If rFind.Offset(1, 0) = Empty Then _
         EndAdr = Cells(rFind.Row, "xx").Address
         
      'ActiveSheet PrintArea festlegen
      ActiveSheet.PageSetup.PrintArea = Range(AnfAdr, EndAdr)
   End If
End Sub

Code:

Sub GruppenBereich_suchen()
Dim rFind As Range, AnfAdr, EndAdr
Dim Eingabe As Variant
Eingabe = InputBox("Bitte Artikel Nummer eingeben")
If Eingabe = Empty Then Exit Sub

   Set rFind = Columns("C").Find(What:=Eingabe, After:=[c1], LookIn:=xlFormulas, _
       LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
       
   If Not rFind Is Nothing Then
      'Anf-Adresse über Offset(1) und End-Adresse über xlDown
      AnfAdr = Cells(rFind.Row, "A").Offset(1, 0).Address
      EndAdr = Cells(rFind.Row, "xx").End(xlDown).Address
         
      'ActiveSheet PrintArea festlegen
      ActiveSheet.PageSetup.PrintArea = Range(AnfAdr, EndAdr)
   End If
End Sub

---

Nachtrag   VOR dem festlegen des PrintBereich gehört noch diese Codezeile, um den alten PrintBereich zu löschen!
    ActiveSheet.PageSetup.PrintArea = Empty