Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Sheets abfragen und zusammenfügen - PDF!


Betrifft: Sheets abfragen und zusammenfügen - PDF! von: Werner Meinke
Geschrieben am: 16.09.2019 09:57:53

Hallo,

Ausgangssituation:
Arbeitsmappe mit 43 Tabellenblättern. Alle sind gleich und unterscheiden sich nur durch ihren Namen.

Jetzt möchte ich über eine Schleife alle Blätter abfragen ob in Celle B100 der Wert Null ist.
Bei allen Blätter in denen der Wert nicht Null ist lösche ich die leeren Zeilen raus (kann ich) und kopiere sie in ein temporäres Tabellenblatt mit Überschriften gleich dem jeweiligen Tabellennamen. Zum Schluss erstelle ich aus dem temporären Blatt eine PDF-Datei (kann ich) und lösche das temporäre Blatt wieder (kann ich).

Jetzt habe ich dazu zwei Fragen:
1. Wie muss ich die Schleife aufbauen und welche Art von Schleife nehme ich?
2. Wie stelle ich es an, wenn am Ende einer Seite für das nächste Blatt nicht mehr genügend Platz ist, dass sie auf der neuen Seite eingefügt wird?

Wäre super dankbar für eure Hilfe. Fange nebenbei selber schon mal das Basteln an!

Gruß
Werner

  

Betrifft: AW: Sheets abfragen und zusammenfügen - PDF! von: 1713262.html
Geschrieben am: 16.09.2019 10:19:47

Hallo

zu 1.

Sub pdf()
    Dim TB
    For Each TB In ThisWorkbook.Sheets
        Select Case TB.Name
        Case "Zusammenfassung", "Temp"
            'Mache nichts 
        Case Else
            'Hier dein Makro 
            'MsgBox "Jetzt auf " & TB.Name 
        End Select
    Next
End Sub


LG UweD
  

Betrifft: AW: Sheets abfragen und zusammenfügen - PDF! von: 1713280.html
Geschrieben am: 16.09.2019 12:32:07

Hallo Werner,

hier ein entsprechendes Makro.

Laufzeit kann bei bis zu 43 Blättern relativ lang sein.
Die Leerzeilen werden nicht in den einzelnen Blättern gelöscht sondern erst nach dem Kopieren in das temporäre Blatt.

LG
Franz

Sub Make_PDF()
 
 
     Dim TB As Worksheet, wksTemp As Worksheet
     Dim zeiTemp As Long, Zeile As Long
     Dim rngCopy As Range
     Dim sPDFName As String, intPages As Integer
     Set wksTemp = ActiveWorkbook.Worksheets("Temp")
     
     Application.ScreenUpdating = False
     zeiTemp = 1
     'Alte Daten im Temp-Blatt löschen
     With wksTemp
         .ResetAllPageBreaks
         .UsedRange.Rows.Delete
     End With
     For Each TB In ActiveWorkbook.Worksheets
         Select Case TB.Name
         Case "Zusammenfassung", wksTemp.Name
             'Mache nichts
         Case Else
             'Hier dein Makro
             If TB.Range("B100") <> 0 Then
                 intPages = wksTemp.HPageBreaks.Count
                 'Tabellenname als Überschrift einfügen
                 wksTemp.Cells(zeiTemp, 1) = TB.Name
                 With wksTemp
                     'Daten nach Batt Temp kopieren - nur Formate und Werte
                     Set rngCopy = TB.UsedRange.EntireRow
                     rngCopy.Copy
                     .Cells(zeiTemp + 1, 1).PasteSpecial Paste:=xlPasteFormats
                     .Cells(zeiTemp + 1, 1).PasteSpecial Paste:=xlPasteValues
                     'leere Zeilen zum löschen im kopierten Block markieren
                     For Zeile = zeiTemp + 1 + rngCopy.Rows.Count - 1 To zeiTemp + 1 Step -1
                         If .Cells(Zeile, .Columns.Count).End(xlToLeft).Column = 1 _
                                 And IsEmpty(.Cells(Zeile, 1)) Then
                             .Cells(Zeile, 1).Value = True
                         End If
                     Next
                     'markierte Zeilen löschen
                     With .Range(.Cells(zeiTemp, 1), .Cells(.Rows.Count, 1).End(xlUp))
                         If Application.WorksheetFunction.CountIf(.Cells, True) > 0 Then
                             .SpecialCells(xlCellTypeConstants, xlLogical).EntireRow.Delete
                         End If
                     End With
                     'Prüfen. ob sich die Anzahl der Seitenwechsel geändert hat
                     If intPages < wksTemp.HPageBreaks.Count Then
                         'festen Seitenwechsel vor Blattname einfügen
                         .HPageBreaks.Add Before:=.Cells(zeiTemp, 1)
                     End If
                     'nächste Enfügezeile ermitteln
                     zeiTemp = .UsedRange.Row + .UsedRange.Rows.Count - 1
                     zeiTemp = zeiTemp + 1
                 End With
             End If
         End Select
     Next
     Application.ScreenUpdating = True
     'Blatt als PDF speichern
     With Application.FileDialog(msoFileDialogSaveAs)
         .Title = "Bitte Dateiname für PDF-Datei wählen/eingeben"
         .FilterIndex = 29 'PDF
         If .Show = -1 Then
             sPDFName = .SelectedItems(1)
             wksTemp.Activate
             wksTemp.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sPDFName, _
                 Quality:=xlQualityStandard,ignoreprintareas:=False, openafterpublish:=True
         End If
     End With
     MsgBox "Fertig"
 End Sub

  

Betrifft: AW: Sheets abfragen und zusammenfügen - PDF! von: 1713782.html
Geschrieben am: 19.09.2019 08:16:49

Guten Morgen,

vielen Dank für dein Makro. Hat mir wirklich super geholfen.

Gruß
Werner

Beiträge aus dem Excel-Forum zum Thema "Sheets abfragen und zusammenfügen - PDF!"