wie kann ich in einer Datei per VBA alle Blätter markieren, deren Name mit einem "a" oder einem "b" endet?
Micha
Sub mark()
Dim Sheet As Worksheet
Dim Arr() As String
ReDim Preserve Arr(1 To ActiveWorkbook.Sheets.Count)
i = 0
For Each Sheet In ActiveWorkbook.Sheets
If Right(Sheet.Name, 1) = "a" Or Right(Sheet.Name, 1) = "b" Then
i = i + 1
Arr(i) = Sheet.Name
End If
Next Sheet
If i > 0 Then Sheets(Arr).Select
End Sub
viele Grüße. HeideSub mark()
Dim Sheet As Worksheet
Dim Arr() As String
Dim i As Long
ReDim Arr(1 To ActiveWorkbook.Sheets.Count)
i = 0
For Each Sheet In ActiveWorkbook.Sheets
If Sheet.Name Like "*[ab]" Then
i = i + 1
Arr(i) = Sheet.Name
End If
Next Sheet
ReDim Preserve Arr(1 To i)
If i > 0 Then Sheets(Arr).Select
End Sub
Gruss, Jogy
Sub mark()
Dim Sheet As Worksheet
Dim Arr() As String
Dim i As Long
ReDim Arr(1 To ActiveWorkbook.Sheets.Count)
i = 0
For Each Sheet In ActiveWorkbook.Sheets
If Sheet.Name Like "*[ab]" Then
i = i + 1
Arr(i) = Sheet.Name
End If
Next Sheet
If i > 0 Then
ReDim Preserve Arr(1 To i)
Sheets(Arr).Select
End If
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Sub mark2()
Dim wks As Worksheet, aStr() As String, lngN As Long
ReDim aStr(1 To ActiveWorkbook.Sheets.Count)
For Each wks In ActiveWorkbook.Sheets
If wks.Name Like "*[ab]" Then
lngN = lngN + 1
aStr(lngN) = wks.Name
End If
Next wks
If lngN > 0 Then
ReDim Preserve aStr(1 To lngN)
Sheets(aStr).Select
End If
End Sub
Sub mark3()
Dim wks As Worksheet, aLng() As Long, lngN As Long
ReDim aLng(1 To ActiveWorkbook.Sheets.Count)
For Each wks In ActiveWorkbook.Sheets
If wks.Name Like "*[ab]" Then
lngN = lngN + 1
aLng(lngN) = wks.Index
End If
Next wks
If lngN > 0 Then
ReDim Preserve aLng(1 To lngN)
Sheets(aLng).Select
End If
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort
Sub mark4()
Dim wks As Worksheet, aLng() As Long, lngN As Long
ReDim aLng(1 To ActiveWorkbook.Worksheets.Count)
For Each wks In ActiveWorkbook.Worksheets
If wks.Name Like "*[ab]" Then
lngN = lngN + 1
aLng(lngN) = wks.Index
End If
Next wks
If lngN > 0 Then
ReDim Preserve aLng(1 To lngN)
Worksheets(aLng).Select
End If
End Sub
Sub mark4()
Dim wks As Object, aLng() As Long, lngN As Long
ReDim aLng(1 To ActiveWorkbook.Sheets.Count)
For Each wks In ActiveWorkbook.Sheets
If wks.Name Like "*[ab]" Then
lngN = lngN + 1
aLng(lngN) = wks.Index
End If
Next wks
If lngN > 0 Then
ReDim Preserve aLng(1 To lngN)
Sheets(aLng).Select
End If
End Sub
@Heide: Fehler macht jeder mal! Ist doch nicht schlimm.Sub TabSelektiern()
Dim sh As Worksheet
Dim i As Long
For i = -1 To 0
For Each sh In ActiveWorkbook.Worksheets
If sh.Name Like "*[ab]" Then sh.Select i
Next
Next
End Sub
Gruß, Daniel
Sub TabSelektiern()
Dim sh As Worksheet, blnR As Boolean
blnR = True ' alte Selektion entfernen
For Each sh In ActiveWorkbook.Worksheets
If sh.Name Like "*[ab]" Then
sh.Select blnR
blnR = False ' alte Selektion nicht entfernen
End If
Next sh
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-LintfortSub TabSelektiern()
Dim sh As Worksheet
Dim i As Boolean
i = True
For Each sh In ActiveWorkbook.Worksheets
If sh.Name Like "*[ab]" Then
sh.Select i
i = False
End if
Next
End Sub
Gruß, Daniel