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
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
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
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
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:
Ich habe dich bisher so verstanden:
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
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
? 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
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
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
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