Makro: Formel um eine Zeile runterziehen

[dertommy]

Hallo!

Ich benötige ein Makro, welches mir die Formeln der letzten ausgefüllten Zeilen (Spalte Q bis CH) um eine Zeile runterzieht.

Vielen Danke für eure Hilfe.

[HKindler]

Hi,

weshalb braucht man so etwas? Excel macht das doch selbst, wenn man weiß, wie man damit umgeht. Stichworte: Intelligente Tabelle oder auch die Option "Datenbereichsformate und -formeln erweitern".

[dertommy]

das Runterziehen der Formeln soll erst nach einer bestimmten Prüfung erfolgen, darum

[HKindler]

Hi,

Code:

Dim i As Long
i = Cells(Rows.Count, "Q").End(xlUp).Row
With Range(Cells(i, "Q"), Cells(i, "CH"))
    .AutoFill .Resize(2)
End With

[dertommy]

Danke sehr, du hast mir sehr geholfen

[dertommy]

Hallo noch einmal!

Ich habe deinen/euren Code etwas erweitert, stehe aber jetzt vor folgenden Problem.

Ich befinde mich derzeit im Tabellenblatt "Auszahlungen". 

Der Code funktioniert bis zur Codestelle ohne Problem:

Code:

ThisWorkbook.Worksheets("Auszahlungen").Activate
   
            Dim i As Long
            i = Cells(Rows.Count, "Q").End(xlUp).Row
           
            With Range(Cells(i, "Q"), Cells(i, "CP"))
                .AutoFill .Resize(2)
            End With
           
            With Range(Cells(i, "FQ"), Cells(i, "FR"))
                .AutoFill .Resize(2)
            End With
           
            With Range(Cells(i, "FU"), Cells(i, "FV"))
                .AutoFill .Resize(2)
            End With
           
            With Range(Cells(i, "FX"), Cells(i, "IQ"))
                .AutoFill .Resize(2)
            End With

Wenn es aber nun zur folgenden Codestelle kommt, macht er leider nicht das, was er machen soll. Er schreibt die Werte/Formeln leider ins Tabellenblatt "Auszahlungen" statt in " Jahresstatistik Top8". Ab hier tritt das Problem auf:

Code:

ThisWorkbook.Worksheets("Jahresstatistik Top8").Activate
       
            With ThisWorkbook.Worksheets("Jahresstatistik Top8")
           
                Dim i2 As Long
                i2 = Cells(Rows.Count, "AA").End(xlUp).Row
               
                With Range(Cells(i2, "AA"), Cells(i2, "BC"))
                    .AutoFill .Resize(2)
                End With
           
            End With

            ThisWorkbook.Worksheets("Auszahlungen").Activate

Hier der gesamte Code:

Code:

  ThisWorkbook.Worksheets("Auszahlungen").Activate
   
            Dim i As Long
            i = Cells(Rows.Count, "Q").End(xlUp).Row
           
            With Range(Cells(i, "Q"), Cells(i, "CP"))
                .AutoFill .Resize(2)
            End With
           
            With Range(Cells(i, "FQ"), Cells(i, "FR"))
                .AutoFill .Resize(2)
            End With
           
            With Range(Cells(i, "FU"), Cells(i, "FV"))
                .AutoFill .Resize(2)
            End With
           
            With Range(Cells(i, "FX"), Cells(i, "IQ"))
                .AutoFill .Resize(2)
            End With
       
            ThisWorkbook.Worksheets("Jahresstatistik Top8").Activate
       
            With ThisWorkbook.Worksheets("Jahresstatistik Top8")
           
                Dim i2 As Long
                i2 = Cells(Rows.Count, "AA").End(xlUp).Row
               
                With Range(Cells(i2, "AA"), Cells(i2, "BC"))
                    .AutoFill .Resize(2)
                End With
           
            End With
           
            ThisWorkbook.Worksheets("Auszahlungen").Activate

Ich hoffe, dass mir jemand helfen kann.

[dertommy]

Ich glaube, dass ich es es nun selbst zusammen gebracht habe, hier der aktuelle Code:

Code:

Dim i As Long
            i = Cells(Rows.Count, "Q").End(xlUp).Row
           
            With Range(Cells(i, "Q"), Cells(i, "CP"))
                .AutoFill .Resize(2)
            End With
           
            With Range(Cells(i, "FQ"), Cells(i, "FR"))
                .AutoFill .Resize(2)
            End With
           
            With Range(Cells(i, "FU"), Cells(i, "FV"))
                .AutoFill .Resize(2)
            End With
           
            With Range(Cells(i, "FX"), Cells(i, "IQ"))
                .AutoFill .Resize(2)
            End With
         
            Dim i2 As Long
            i2 = Worksheets("Jahresstatistik Top8").Cells(Rows.Count, "AA").End(xlUp).Row
           
            With ThisWorkbook.Worksheets("Jahresstatistik Top8")
               
                With .Range(Worksheets("Jahresstatistik Top8").Cells(i2, "AA"), Worksheets("Jahresstatistik Top8").Cells(i2, "BC"))
                    .AutoFill .Resize(2)
                End With
               
            End With

[_MCO_]

Hi!

Wahrscheinlich hast du nur den Punkt bei RANGE vergessen (rot)
aus dem Beispiel wie folgt ersichtlich:

ThisWorkbook.Worksheets("Jahresstatistik Top8").Activate
     
            With ThisWorkbook.Worksheets("Jahresstatistik Top8")
         
                Dim i2 As Long
                i2 = Cells(Rows.Count, "AA").End(xlUp).Row
             
                With Range(Cells(i2, "AA"), Cells(i2, "BC"))
                    .AutoFill .Resize(2)
                End With

Mit .Activate ist alles, was nicht in WITH steht für das Blatt "Top8".
Alles was sich auf WITH beziehen soll, muss einen führenden Punkt haben!

Wenn du das beachtest, kannst du komplett auf .select und .activate verzichten und damit Blattwechsel vermeiden.
Im laufenden Code ist damit das lästige Geflacker beendet und dein Code läuft deutlich schneller.

Bau das mal ein...
Viel Erfolg!
Gruß, MCO

[Andreas Killer]

Mit .Activate ist alles, was nicht in WITH steht für das Blatt "Top8".
Alles was sich auf WITH beziehen soll, muss einen führenden Punkt haben!

Das ist falsch.

Wenn Range mit 2 Argumenten ausgerufen wird, dann wird NICHT das Range-Objekt referenziert sondern die Range-Funktion. Die Funktion bildet die Referenzen zum Blatt aus den übergebenen (Range-) Argumenten.

Code:

Sub Test()
  With Worksheets("Tabelle2")
    With Range(.Cells(1, 1), .Cells(1, 3))
      .Value = "x"
    End With
  End With
End Sub

Mach eine neue Datei,  Tabelle1 ist das aktive Blatt, der Code schreibt in die Zellen in Tabelle2 obwohl Range keinen Punkt hat.

Wenn wir das Scenario jedoch umdrehen und mit dem Punkt die Funktion explizit an WITH binden, dann bekommen wir einen RTE, weil die CELLS in diesem Fall auf Tabelle1 referenzieren.

Code:

Sub Test()
  With Worksheets("Tabelle2")
    With .Range(Cells(1, 1), Cells(1, 3))
      .Value = "x"
    End With
  End With
End Sub

Andreas.

[slowboarder]

Hi

bei Range(Cells, Cells) muss das Tabellenblatt immer vor den beiden Cells stehen (und bei With eben die Punkte)
vor Range darf normalerweise wegfallen, da es die Cells sind, die die Range definieren und nicht umgekehrt.

die Ausnahme ist, wenn der Code in einem Tabellenblattmodul steht
dann würde eine Referenzierung ohne Tabellenblattangabe nicht auf das aktive Tabellenblatt laufen, sondern auf das Blatt des Moduls
und in diesem Fall muss man dann das Tabellenblatt vor Range UND vor den beiden Cells angeben.

Weil das kompliziert ist, vermeide ich Range(Cells, Cells) und arbeite lieber mit Resize:

PHP-Code:

Dim rng As Range
For Each rng In Intersect(Cells(Rows.Count, 1).End(xlUp).EntireRow, Range("Q:CP,FQ:FR,FU:FV,FX:IQ")).Areas
    rng.AutoFill rng.Resize(2)
Next

With Sheets("jahresstatistik Top8").Cells(Rows.Count, "AA").End(xlUp).Resize(, 29)
    .AutoFill .Resize(2)
End With


für den ersten Teil des Codes habe ich eine Bearbeitung mit Schleife gewählt, um nicht jeden Bereich einzeln programmieren zu müssen.
Areas sind ein Zwischending zwischen Cells und Range, es sind lückenlosen, rechteckigen Zellbereiche, aus denen eine Range zusammengesetzt ist, also im Prinzip jeder mit Komma abgetrennte Zellbereich im Adressstring.

Gruß Daniel

---

noch ne Optimierung:

die Formeln kann man auch automatisch von Excel ermitteln lassen, wenn nur die Formeln runter gezogen werden sollen:

PHP-Code:

dim rng as Range
for each rng in Cells(Rows.Count, "Q").end(xlup).Resize(, 235).SpecialCells(xlcelltypeformulas).Areas
    rng.autofill rng.Resize(2)
next