Clever-Excel-Forum

Guten Morgen zusammen,

ich bearbeite gerade eine Excel-Datei in dieser immer wieder die gleich Arbeitsschritte ausgeführt werden müssen.
Das einzige was sich ändert, ist die Zeile in der diese Arbeitsschritte ausgeführt werden sollen.
Daher bin ich auf die Idee gekommen die Arbeitsschritte mit Hilfe eines Makros automatisch ausführen zu lassen.
Das Makro der Arbeitsschritte ist folgendes:

Code:
Sub Vier1()

'

' Vier1 Makro

'

' Tastenkombination: Strg+b

'

    Rows("13390:13393").Select

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

    Range("C13385:C13388").Select

    Selection.Copy

    Range("C13390").Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

    Range("A13393:D13393").Select

    Range("D13393").Activate

    Selection.Borders(xlDiagonalDown).LineStyle = xlNone

    Selection.Borders(xlDiagonalUp).LineStyle = xlNone

    Selection.Borders(xlEdgeLeft).LineStyle = xlNone

    Selection.Borders(xlEdgeTop).LineStyle = xlNone

    With Selection.Borders(xlEdgeBottom)

        .LineStyle = xlContinuous

        .ColorIndex = xlAutomatic

        .TintAndShade = 0

        .Weight = xlThick

    End With

    Selection.Borders(xlEdgeRight).LineStyle = xlNone

    Selection.Borders(xlInsideVertical).LineStyle = xlNone

    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone

    Range("B13389:B13393").Select

    Range("B13393").Activate

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = True

    End With

    Range("A13389:A13393").Select

    Range("A13393").Activate

    With Selection

        .HorizontalAlignment = xlCenter

        .VerticalAlignment = xlCenter

        .WrapText = True

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = True

    End With

End Sub

Der inhalt des Makros ist richtig und soll sich nicht ändern. Das einzige was sich ändern soll sind die Zeilen in denen es ausgeführt wird.
Also soll in immer neue Zeilen der gleich Inhalt.

Wie kann ich das in diesem Makro ändern?

Einen schönen Start in die Woche und vielen Dank für eure Hilfe!

Hallo,

woher weiß ich denn, auf welche Zelle/Zeile der Code angewandt werden soll? Irgendein Kriterium braucht man, um zu wissen, welche Zellen betroffen sind (z. B. aktive Zelle, letzte Zeile des Tabellenblatts, 5 Zeilen unter der Zelle, die das Wort "Hallo" beinhaltet, etc.).

Erklär das mal genauer und lade ggf. eine Beispeldatei hier hoch.

Und nochetwas: Verwende bitte Code-Tags, dann ist der Code leichter lesbar.

Moin!
Benutze ListObjects (intelligente Tabellen, Strg+t), dann kannst Du Dir das ganze Rekordergedöns schenken.

Gruß Ralf

Hi,

jetzt mal unabhängig von den anderen Antworten hier das Makro ohne die Selects und Activates und etwas gekürzt:

Code:
Option Explicit

Sub Vier1()

   '

   ' Vier1 Makro

   '

   ' Tastenkombination: Strg+b

   '

   Rows("13390:13393").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

   Range("C13385:C13388").Copy Range("C13390").Paste

   Application.CutCopyMode = False

   With Range("A13393:D13393")

      .Borders(xlDiagonalDown).LineStyle = xlNone

      .Borders(xlDiagonalUp).LineStyle = xlNone

      .Borders(xlEdgeLeft).LineStyle = xlNone

      .Borders(xlEdgeTop).LineStyle = xlNone

      With .Borders(xlEdgeBottom)

         .LineStyle = xlContinuous

         .ColorIndex = xlAutomatic

         .TintAndShade = 0

         .Weight = xlThick

      End With

      .Borders(xlEdgeRight).LineStyle = xlNone

      .Borders(xlInsideVertical).LineStyle = xlNone

      .Borders(xlInsideHorizontal).LineStyle = xlNone

   End With

   With Range("A13389:B13393")

      .HorizontalAlignment = xlCenter

      .VerticalAlignment = xlCenter

      .WrapText = True

      .Orientation = 0

      .AddIndent = False

      .IndentLevel = 0

      .ShrinkToFit = False

      .ReadingOrder = xlContext

      .MergeCells = True

   End With

   With Range("B13389:B13393")

      .WrapText = False

   End With

End Sub

Kimm

Der Steuerfuzzi

RPP63

Rabe