Supportnet Computer
Planet of Tech

Supportnet / Forum / Tabellenkalkulation

Autofill von der Aktiven Zelle aus





Frage

Hallo, ich habe da mal eine Frage, kann man mit einem Makro von der aktiven Zeile die nächsten fünf Zeilen mit Autofill ausfüllen. Gruß fedjo z.B. Sub Makro1() Range("A1:O1").Select Selection.Copy Dim Spalte As Integer Spalte = 1 If IsEmpty(Cells(Cells.Rows.Count, Spalte).End(xlUp)) Then _ GoTo Fehler Cells(Cells.Rows.Count, Spalte).End(xlUp).Select ActiveCell.Offset(1, 0).Select ActiveSheet.Paste Exit Sub Fehler: Cells(Cells.Rows.Count, Spalte).End(xlUp).Select Application.CutCopyMode = False Selection.AutoFill Destination:=Range("A5:O10"), Type:=xlFillDefault Range("A5:O10").Select End Sub

Antwort 1 von JoeKe

Moin fedjo,

versuch es mal so:

Sub Autofill()
Dim Zeile As Long, Spalte As Integer
Zeile = ActiveCell.Row
Spalte = 1 ´ActiveCell.Column
ActiveCell.AutoFill Destination:=Range(Cells(Zeile, Spalte), _
Cells(Zeile, Spalte + 14)), Type:=xlFillSeries
Range(Cells(Zeile, Spalte), Cells(Zeile, Spalte + 14)).AutoFill _
Destination:=Range(Cells(Zeile, Spalte), _
Cells(Zeile + 5, Spalte + 14)), Type:=xlFillDefault
End Sub


Falls die aktive Zelle nicht auf Spalte A begrenz werden soll, kannst du alternativ ActiveCell.Column für eine dynamische Verwendendung einsetzen.

MfG

JöKe

Antwort 2 von fedjo

Hallo JöKe,
danke für deineHilfe.
Beim testen wird bei mir bei der Zeile
"Spalte = 1 ´ActiveCell.Column" ein Syntaxfehler angezeigt.

Was mache ich falsch?

Gruß
fedjo

Antwort 3 von JoeKe

Hallo fedjo,

das liegt daran das hier das Hochkomma (Shift+Raute) nicht dargestellt wird.
Wenn du nur, wie in deinem Beispiel auch Spalte=1 benötigst lösch alles hinter der 1. Falls deine aktive Zelle auch in einer andeen Spalte liegen kann lösch alles vor ActiveCell.Column.

MfG

JöKe

Antwort 4 von fedjo

Hallo JöKe,
das Autofill funktioniert so nach deinen Angaben.
Ich habe es in mein Makro eingebaut, das aber dann nicht den gewünschten Erfolg bringt.
Wo liegt der Fehler?

Gruß
fedjo

Sub Autofill()
Range("A1:O1").Select
Selection.Copy

Dim Spalte As Integer
Spalte = 1
If IsEmpty(Cells(Cells.Rows.Count, Spalte).End(xlUp)) Then _
GoTo Fehler
Cells(Cells.Rows.Count, Spalte).End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Exit Sub
Fehler:
Cells(Cells.Rows.Count, Spalte).End(xlUp).Select

Application.CutCopyMode = False

Dim Zeile As Long
Zeile = ActiveCell.Row
Spalte = 1
ActiveCell.Autofill Destination:=Range(Cells(Zeile, Spalte), _
Cells(Zeile, Spalte + 14)), Type:=xlFillSeries
Range(Cells(Zeile, Spalte), Cells(Zeile, Spalte + 14)).Autofill _
Destination:=Range(Cells(Zeile, Spalte), _
Cells(Zeile + 5, Spalte + 14)), Type:=xlFillDefault
End Sub

Antwort 5 von JoeKe

Hallo fedjo,

leider verstehe ich nicht was du mit deinem Code erreichen willst.
Er kopiert doch nur die letzte Zeile die in Spalte A einen Wert hat eine Zeile tiefer. Und wofür ist das:

Zitat:
If IsEmpty(Cells(Cells.Rows.Count, Spalte).End(xlUp)) Then _
GoTo Fehler
.......
Fehler:
Cells(Cells.Rows.Count, Spalte).End(xlUp).Select
?

Ich habe dich bisher so verstanden:
    -in den Spalten A - O stehen Werte die 5 Zeilen nach unten kopiert werden sollen.
    -die Zeile soll die letzte gefüllte Zeile der Spalte A sein.


Wenn das so richtig ist, sollte folgender Code funktionieren:

Option Explicit

Sub Autofill()
Dim Zeile As Long
Zeile = Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(Zeile, 1), Cells(Zeile, 15)).Autofill _
Destination:=Range(Cells(Zeile, 1), _
Cells(Zeile + 5, 15)), Type:=xlFillSeries
End Sub


Frohe Ostern

JöKe

Antwort 6 von fedjo

Hi JöKe,
danke für deine Mühe.
Ich hoffe das es jetzt verständlich ist.

Schöne Feiertage
fedjo

Sucht die nächste leere Zelle in Spalte (A)
"If IsEmpty(Cells(Cells.Rows.Count, Spalte).End(xlUp)) Then _
GoTo Fehler
.......
Fehler:
Cells(Cells.Rows.Count, Spalte).End(xlUp).Select "

Alle leeren Zeilen sollten gelöscht werden.
Zellen A1:O1 (Inhalt Funktionen, sie übernehmen Daten aus einem anderen Tabellenblatt.) werden kopiet. Die nächste leere Zelle in Spalte (A) wird gesucht und der Inhalt eingefügt.
Autofill sollte danach von der aktiven Zeile aus die Funktionen fünf Zeilen nach unten kopieren.


Sub Autofill()
Dim r As Range
Dim col As New Collection

For Each r In ActiveSheet.UsedRange.EntireRow

If WorksheetFunction.CountBlank(Rows(r.Row)) = 256 Then
col.Add r
End If
Next

For Each r In col
r.Delete
Next

Range("A1:O1").Select
Selection.Copy

Dim Spalte As Integer
Spalte = 1
If IsEmpty(Cells(Cells.Rows.Count, Spalte).End(xlUp)) Then _
GoTo Fehler
Cells(Cells.Rows.Count, Spalte).End(xlUp).Select
ActiveCell.Offset(1, 0).Select
ActiveSheet.Paste
Application.SendKeys "{ESC}"
Exit Sub
Fehler:
Cells(Cells.Rows.Count, Spalte).End(xlUp).Select

Dim Zeile As Long
Zeile = Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(Zeile, 1), Cells(Zeile, 15)).Autofill _
Destination:=Range(Cells(Zeile, 1), _
Cells(Zeile + 5, 15)), Type:=xlFillSeries
End Sub

Antwort 7 von JoeKe

Hallo fedjo,

ich denke ich habs:

Sub Autofill()
Dim r As Range
Dim col As New Collection
Dim Zeile As Long
For Each r In ActiveSheet.UsedRange.EntireRow
If WorksheetFunction.CountBlank(Rows(r.Row)) = 256 Then
col.Add r
End If
Next
For Each r In col
r.Delete
Next
Range("A1:O1").Copy
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial
Zeile = Cells(Rows.Count, 1).End(xlUp).Row
Range(Cells(Zeile, 1), Cells(Zeile, 15)).Autofill _
Destination:=Range(Cells(Zeile, 1), _
Cells(Zeile + 5, 15)), Type:=xlFillSeries
End Sub



JöKe

Antwort 8 von fedjo

Hi JöKe,
du hast recht, das Makro funktioniert super geanau so hab ich mir das vorgestellt.

Vielen Dank noch mal für deine Hilfe.

Frohe Ostern
Gruß
fedjo

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: