Aufführen eines Makros auf mehreren Blättern

Option Explicit



Sub Preiserhöhung()



    Dim wksSheet As Worksheet

    Dim LastRow As Long

    Dim i As Long

    Dim LastColumn As Long

    Dim LastColumn_A As Long

    Dim LastColumn_Buchstabe As String

    



    For Each wksSheet In ThisWorkbook.Worksheets



    Select Case wksSheet.Name

    Case "Leerschränke allg. Verwendung", "Leerschränke|-säulen"

    With wksSheet

    

    'Spalte vor Spalte E einfügen

    Columns("E:E").Select

    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    

    'Spalte F in Spalte E kopieren

    Columns("F:F").Select

    Selection.Copy

    Columns("E:E").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    

    'Spalte F umbenennen mit aktuellem Datum

    Range("F1").Select

    ActiveCell.FormulaR1C1 = Date

    

    'Letzte Spalte finden

    LastColumn = wksSheet.Cells(, wksSheet.Columns.Count).End(xlToLeft).Column

    

    'Zwischenrechnung

    LastColumn_A = LastColumn - 5

    

    'Alte Preise ausblenden

    Columns(6).Resize(, LastColumn_A).EntireColumn.Select

    Selection.EntireColumn.Hidden = True

      

    ' Letzte Zeile in der Spalte A finden

    LastRow = wksSheet.Cells(wksSheet.Rows.Count, "A").End(xlUp).Row

    

    ' Schleife durch die Zeilen

    For i = 2 To LastRow ' Wir beginnen bei Zeile 2, da Zeile 1 normalerweise die Überschriften enthält

        If wksSheet.Cells(i, 4).Value = 1 Then

            ' Wenn "Preiskategorie" gleich 1 ist, fügen Sie 1 zum Wert in "Preis" hinzu

            wksSheet.Cells(i, 5).Value = wksSheet.Cells(i, 5).Value * 2

        ElseIf wksSheet.Cells(i, 4).Value = 2 Then

            ' Wenn "Preiskategorie" gleich 2 ist, fügen Sie 2 zum Wert in "Preis" hinzu

            wksSheet.Cells(i, 5).Value = wksSheet.Cells(i, 5).Value * 2

        End If

        

    Next i



    End With

    Case Else

    

    End Select



    Next wksSheet



End Sub