VBA-Code auf mehrere Sheets anwenden

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Andy,
am besten nimmst Du Deine gewünschten Aktionen mit dem Recorder für ein Blatt auf und bereinigst anschließend das Ergebnis um überflüssigen Code. Insbesondere Select und Activate ist meistens unnötig.
Anschließend baust Du Dir eine Schleife (hier Worksheet-Schleife) um das Ergebnis.
Hier ein Beispiel:

Option Explicit

Sub Makro1()

 Dim WSh As Worksheet

 For Each WSh In ThisWorkbook.Worksheets

    WSh.sOrt.SortFields.Clear

    WSh.sOrt.SortFields.Add2 Key:=Range( _

        "B1:B132"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

        xlSortNormal

    With WSh.sOrt

        .SetRange Range("B1:B132")

        .Header = xlGuess

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

    With WSh.Cells.Font

        .ThemeColor = xlThemeColorLight1

        .TintAndShade = 0

    End With

    With WSh.Cells.Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .ThemeColor = xlThemeColorDark1

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

 Next WSh

End Sub

viele Grüße
Karl-Heinz

Hallo Andy,
teste mal:

Option Explicit

Public Sub Sortieren()

    Dim lngIndex As Long
    Dim objWorksheet As Worksheet

    For lngIndex = 1 To 10

        Set objWorksheet = ThisWorkbook.Worksheets(Application.Roman(lngIndex))

        With objWorksheet.Sort

            Call .SortFields.Clear
            Call .SortFields.Add(Key:=objWorksheet.Cells(1, 2), _
                SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal)
            Call .SetRange(Rng:=objWorksheet.UsedRange)
            .Header = xlYes
            .MatchCase = False
            .Orientation = xlTopToBottom
            .SortMethod = xlPinYin
            Call .Apply

        End With

        With objWorksheet.UsedRange

            .Font.Color = vbBlack
            .Interior.Pattern = xlPatternNone

        End With
    Next

    Set objWorksheet = Nothing

End Sub

Gruß
Nepumuk

Sub MehrereSheetsAnsprechen() Dim MeineBlätter As Variant 'Liste meiner Arbeitsblätter MeineBlätter = Array("I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX", "X") 'Loop meiner Arbeitsblätter For x = LBound(MeineBlätter) To UBound(MeineBlätter) 'Setze den Hintergrund auf Nichts zurück (.Cells = alle Zellen) ThisWorkbook.Worksheets(MeineBlätter(x)).Cells.Interior.ColorIndex = xlNone 'Mach die Schrift schwarz (.Cells = alle Zellen) ThisWorkbook.Worksheets(MeineBlätter(x)).Cells.Font.ColorIndex = 1 ThisWorkbook.Worksheets(MeineBlätter(x)).Range("A1:B11").Sort _ Key1:=Range("B"), Order1:=xlDescending, _ Header:=xlNo Next x End Sub

Sub MehrereSheetsAnsprechen() Dim MeineBlätter As Variant 'Liste meiner Arbeitsblätter MeineBlätter = Array("I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX", "X") 'Loop meiner Arbeitsblätter For x = LBound(MeineBlätter) To UBound(MeineBlätter) 'Setze den Hintergrund auf Nichts zurück (.Cells = alle Zellen) With ThisWorkbook.Worksheets(MeineBlätter(x)) .Cells.Interior.ColorIndex = xlNone 'Mach die Schrift schwarz (.Cells = alle Zellen) .Cells.Font.ColorIndex = 1 .Range("A1:B11").Sort Key1:=.Range("B1"), Order1:=xlDescending, Header:=xlNo End With Next x End Sub

Sub MehrereSheetsAnsprechen() Dim MeineBlätter As Variant 'Liste meiner Arbeitsblätter MeineBl?tter = Array("I", "II", "III", "IV", "V", "VI", "VII", "VIII", "IX", "X") 'Loop meiner Arbeitsblätter For x = LBound(MeineBlätter) To UBound(MeineBlätter) With ThisWorkbook.Worksheets(MeineBlätter(x)) 'Setze den Hintergrund auf Nichts zurück (.Cells = alle Zellen) .Cells.Interior.ColorIndex = xlNone 'Mach die Schrift schwarz (.Cells = alle Zellen) .Cells.Font.ColorIndex = 1 'Sortiere gesamtes Blatt aufsteigend nach Spalte B ab zweiter Zeile (Header:=xlYes) .Cells.Sort Key1:=.Range("B2"), Order1:=xlAscending, Header:=xlYes End With Next x End Sub

Beliebteste Forumthreads (12 Monate)

VBA-Code auf mehrere Sheets anwenden

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

132 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA-Code auf mehrere Sheets anwenden

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

132 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread