Excel-Makro abändern

[Kimm]

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!

[Der Steuerfuzzi]

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.

[RPP63]

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

Gruß Ralf

[Rabe]

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