Blätter auswählen

Guten Morgen,
ich habe in meiner Excel Datei ein Makro wodurch mir alle Blätter (bis auf Übersicht, Massen und Preis) ausgewählt werden. Das Funktioniert auch tatellos.


'Blätterauswählen
Dim arrBlatt() As String, iIndex As Long, objWb As Workbook, objWks As Worksheet
Set objWb = ActiveWorkbook
iIndex = 0
For Each objWks In objWb.Worksheets
Select Case objWks.Name
Case "Übersicht", "Massen", "Preis"
'Blattnamen der Ausnahmen
Case Else
iIndex = iIndex + 1
ReDim Preserve arrBlatt(1 To iIndex)
arrBlatt(iIndex) = objWks.Name
End Select
Next
If iIndex > 0 Then
objWb.Sheets(arrBlatt).Select
End If

Jetzt möchte ich aber noch eine Bedingung mit einfügen. Und zwar wenn im Tabellenblatt "Übersicht" ab der Spalte G7 nichts steht sollen die Blätter (in der Spalte A befindet sich der gleiche Name wie die Blätter haben) nicht mit ausgewählt werden.
Ich hoffe es ist einigermasen verständlich ausgedrückt was ich vor habe.
MfG Markus

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub BlattWählen() Dim arrBlatt() As String, iIndex As Long, objWb As Workbook, objWks As Integer, i As Integer Set objWb = ActiveWorkbook iIndex = 0 For objWks = 1 To Worksheets.Count For i = 7 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row If Sheets(objWks).Name = Sheets(1).Cells(i, 1).Value _ And Sheets(objWks).Name "Übersicht" And Sheets(objWks).Name "Massen" And Sheets(objWks).Name "Preis" _ And Sheets(1).Cells(i, 7).Value "" Then iIndex = iIndex + 1 ReDim Preserve arrBlatt(1 To iIndex) arrBlatt(iIndex) = Sheets(objWks).Name End If Next i Next objWks If iIndex > 0 Then objWb.Sheets(arrBlatt).Select End If End Sub

Private Sub CommandButton2_Click() 'Blätter auswählen, die abgearbeitet worden sind und als PDF ausgeben Dim objCell As Range Dim astrWorksheets() As String Dim ialngIndex As Long ReDim astrWorksheets(0) astrWorksheets(0) = "Zusammenstellung" For Each objCell In Range(Cells(8, 7), Cells(Rows.Count, 7).End(xlUp)) If Not IsEmpty(objCell.Value) Then ialngIndex = ialngIndex + 1 ReDim Preserve astrWorksheets(ialngIndex) astrWorksheets(ialngIndex) = CStr(objCell.Offset(0, -6).Value) End If Next If ialngIndex > 0 Then Call Worksheets(astrWorksheets).Select Call ActiveSheet.ExportAsFixedFormat(Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\XXX.pdf") Call Me.Select End If End Sub

Private Sub CommandButton2_Click() 'Blätter auswählen, die abgearbeitet worden sind und als PDF ausgeben Dim objCell As Range Dim strWorksheets As String Dim arrWorkSheets strWorksheets = "Zusammenstellung" For Each objCell In Range(Cells(8, 7), Cells(Rows.Count, 7).End(xlUp)) If Not IsEmpty(objCell.Value) Then strWorksheets = strWorksheets & "?" & objCell.Offset(, -6) End If Next arrWorkSheets = Split(strWorksheets, "?") If UBound(arrWorkSheets) > 0 Then Call Worksheets(arrWorkSheets).Select Call ActiveSheet.ExportAsFixedFormat(Type:=xlTypePDF, Filename:=ThisWorkbook.Path & "\XXX.pdf") Call Me.Select End If End Sub

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Blätter auswählen

3 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)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread