Live-Forum - Die aktuellen Beiträge
Datum
Titel
23.04.2024 14:59:21
Zellformel in VBA
23.04.2024 14:47:39
Formel SVERWEIS
23.04.2024 14:27:08
Excel - Zellen verketten anhand anderer Spalte
23.04.2024 14:23:45
Gehe zu Tabellenblatt
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
1460to1464
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
1460to1464
1460to1464
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Makro AutoFill Range anpassen

Makro AutoFill Range anpassen
24.11.2015 09:15:25
Arthur
Hallo zusammen
Ich habe ein simples Makro aufgenommen und das funktioniert gut.
Nur ist das Problem, dass ich dieses Makro an verschiedene Listen anwenden werde.
Sprich die "Range:E5ist nicht immer bis H31, es kann nur bis H8 sein, aber auch bis H2345 gehen. Je nachdem wie viele Zellen in H gefüllt sind.
Wie muss ich deshalb dieses Makro anpassen, dass Excel so weit ausfüllt bis zum letzten Eintrag?:
Range("E5:H5").Select
Selection.AutoFill Destination:=Range("E5:H31")
Range("E5:H31").Select
Range("L5").Select
Selection.AutoFill Destination:=Range("L5:L31")
Range("L5:L31").Select
Vielen Dank für eure Hilfe
Gruss
Arthur

9
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Makro AutoFill Range anpassen
24.11.2015 09:47:04
Daniel
Hi
Range("E5:H5").Autofill Destination:=Range("E5:H" & Cells(Rows.Count, "H").End(xlup).Row)
Gruß Daniel

AW: Makro AutoFill Range anpassen
25.11.2015 01:27:05
Arthur
Hi Daniel
Leider habe ich kaum VBA Kenntnisse. Was muss ich nun mit deinem Code machen?
Das oben erwähnte ist ein teil eines ganzen makros, nicht ein einziges.
Ich habe jetzt mal:
Range("E5:H5").Select
Selection.AutoFill Destination:=Range("E5:H31")
mit:
Range("E5:H5").Autofill Destination:=Range("E5:H" & Cells(Rows.Count, "H").End(xlup).Row)
ersetzt, dann kommt der Debugger. Funktioniert also nicht.
Was müsste ich denn auch noch für L5 genau machen?
Vielen Dank für eure Hilfe
Gruss
Arthur

Anzeige
AW: Makro AutoFill Range anpassen
25.11.2015 11:48:07
fcs
Hallo Arthur,
in meiner Antwort
https://www.herber.de/forum/messages/1460305.html
ist eigentlich alles drin.
Im 1. Schritt letzte Zeile mit Daten bestimmen.
Nach Prüfung der Zeilen-Nummer dann die zwei Zellbereiche bis zu dieser letzten Zeile auffüllen.
Ich bevorzuge halt die Cells-Schreibweise bei der Programmierung vpn Range-Objekten, aber da kann man die Nummer der Spalte (A=1, B=2, usw.) ja zur Not an den Fingern abzählen.
Gruß
Franz

AW: Makro AutoFill Range anpassen
27.11.2015 07:34:16
Arthur
Hallo Franz
Ich habe diesen Teil meines ganzen Makros:
Range("E5:H5").Select
Selection.AutoFill Destination:=Range("E5:H31")
Range("E5:H31").Select
Range("L5").Select
Selection.AutoFill Destination:=Range("L5:L31")
Range("L5:L31").Select
Range("M5").Select
Selection.NumberFormat = "0.00%"
Selection.AutoFill Destination:=Range("M5:M31")
Range("M5:M31").Select
Range("A5").Select
rausgelöscht und dein Makro reinkopiert:
Set wks = ActiveSheet
With wks 

Sub AutoFill_E_to_H_and_L()
Dim Zeile_L As Long
Dim wks As Worksheet
'Letzte ausgefüllte Zeile in Spalte H - ggf. andere Spalte wählen, um Letzte ausgefüllte Zeile   _
_
zu ermitteln
Zeile_L = .Cells(.Rows.Count, 8).End(xlUp).Row
If Zeile_L > 5 Then
'Bereich E5:H5 bis Listenende auffüllen
.Range(.Cells(5, 5), .Cells(5, 8)).AutoFill Destination:=.Range(.Cells(5, 5), .Cells( _
Zeile_L, 8))
'Bereich L5 bis Listenende auffüllen
.Cells(5, 12).AutoFill Destination:=.Range(.Cells(5, 12), .Cells(Zeile_L, 12))
End If
End With
End Sub
Jetzt kommt aber eine Fehlermeldung, "Kompilierung".
Ich habe wirklich kaum VBA Kenntnisse, aber ich denke das geht doch gar nicht ein Makro innerhalb eines anderen Makros zu haben.
Ich lösche mein Teil meines Makros raus und was genau muss ich ersetzen, damit das Makro trotzdem so funktioniert wie vorher, aber halt nicht nur bis zeile 31 sondern unterschiedlich, je nach liste die gerade bearbeitet wird?
Vielen Dank für deine Hilfe
Gruss
Arthur.

Anzeige
AW: Makro AutoFill Range anpassen
28.11.2015 01:12:38
fcs
Hallo Arthur,
die Zeilen
Sub Makroname()
und
End Sub
gibt es nur einmal pro Makro. Sie definieren Beginn und Ende eines Makros. Diese Zeilen darfst du nicht mit kopieren, wenn du die Code-Zeilen in vorhandenes Makro einfügen willst.
Die Deklaration der Variablen muss vor der 1. Verwendung der Variablen stehen.
Der besseren Übersicht halber fügt man alle Variablen-Deklarationen direkt nach der Sub-Zeile ein.
Gruß
Franz 

'Zeile mit Makroname - nur einmal als 1. Zeile eines Makros
Sub AutoFill_E_to_H_and_L()
'Deklararation von Variablen - vor 1. Verwendung im Makro - besser als 1. Zeilen im Makro
Dim Zeile_L As Long
Dim wks As Worksheet
'Start der Zeilen, die deine ersetzen
Set wks = ActiveSheet 'Tabellenblatt einer Variablen zuweisen
With wks
'Letzte ausgefüllte Zeile in Spalte H - ggf. andere Spalte wählen, um letzte _
ausgefüllte Zeile zu ermitteln
Zeile_L = .Cells(.Rows.Count, 8).End(xlUp).Row
If Zeile_L > 5 Then
'Bereich E5:H5 bis Listenende auffüllen
.Range(.Cells(5, 5), .Cells(5, 8)).AutoFill _
Destination:=.Range(.Cells(5, 5), .Cells(Zeile_L, 8))
'Bereich L5 bis Listenende auffüllen
.Cells(5, 12).AutoFill Destination:=.Range(.Cells(5, 12), .Cells(Zeile_L, 12))
'Bereich M5 bis Listenende auffüllen
.Cells(5, 13).NumberFormat = "0.00%"
.Cells(5, 13).AutoFill Destination:=.Range(.Cells(5, 13), .Cells(Zeile_L, 13))
End If
End With
'Ende der Zeilen, die deine ersetzen
'Letzte Zeile nur einmal am Ende eines Makros
End Sub

Anzeige
AW: Makro AutoFill Range anpassen
30.11.2015 08:45:18
Arthur
Hallo Franz
Vielen Dank für deine Erklärung. Aber wenn ich nun haargenau diesen Text hier:
'Deklararation von Variablen - vor 1. Verwendung im Makro - besser als 1. Zeilen im Makro
Dim Zeile_L As Long
Dim wks As Worksheet
'Start der Zeilen, die deine ersetzen
Set wks = ActiveSheet 'Tabellenblatt einer Variablen zuweisen
With wks
'Letzte ausgefüllte Zeile in Spalte H - ggf. andere Spalte wählen, um letzte _
ausgefüllte Zeile zu ermitteln
Zeile_L = .Cells(.Rows.Count, 8).End(xlUp).Row
If Zeile_L > 5 Then
'Bereich E5:H5 bis Listenende auffüllen
.Range(.Cells(5, 5), .Cells(5, 8)).AutoFill _
Destination:=.Range(.Cells(5, 5), .Cells(Zeile_L, 8))
'Bereich L5 bis Listenende auffüllen
.Cells(5, 12).AutoFill Destination:=.Range(.Cells(5, 12), .Cells(Zeile_L, 12))
'Bereich M5 bis Listenende auffüllen
.Cells(5, 13).NumberFormat = "0.00%"
.Cells(5, 13).AutoFill Destination:=.Range(.Cells(5, 13), .Cells(Zeile_L, 13))
End If
End With
'Ende der Zeilen, die deine ersetzen
'Letzte Zeile nur einmal am Ende eines Makros
Einfüge wo meine mit dem Makroaufzeichner erstellten Schritte sind (die funktionieren) geht es nicht.
Excel zieht die Zeilen (Verknüpfungen) nicht bis zur letzten Zeile hinunter.
Hier das ganze Makro:
Sub Makro3()
' Makro3 Makro
wsAkt = ActiveSheet.Name
wbAkt = ActiveWorkbook.Name
Windows(wbAkt).Activate
Rows("4:4").Select
Selection.Delete Shift:=xlUp
Rows("3:3").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A:D,I:L").Select
Range("I1").Activate
ActiveWindow.SmallScroll ToRight:=12
Range("A:D,I:L,U:V,X:X").Select
Range("X1").Activate
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("K:K").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("K4").Select
ActiveCell.FormulaR1C1 = "ZCP7 in System"
Range("K5").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-8],ZCP7.xlsx!R10C7:R2000C14,8,FALSE)),"""",((VLOOKUP(RC[-8], _
ZCP7.xlsx!R10C7:R2000C14,8,FALSE))))"
Range("K5").Select
Selection.NumberFormat = "0.0"
Selection.NumberFormat = "0.00"
Selection.NumberFormat = "0.000"
Windows("ZCP7.xlsx").Activate
Windows("ZCP7 Calculation tool.xlsm").Activate
Range("E4:F5").Select
Selection.Copy
Windows(wbAkt).Activate
Range("E4").Select
ActiveSheet.Paste
Range("E5:F5").Select
Application.CutCopyMode = False
Selection.NumberFormat = "0.000"
Selection.NumberFormat = "0.00"
Windows("ZCP7 Calculation tool.xlsm").Activate
Range("H4:I4").Select
Selection.Copy
Windows(wbAkt).Activate
Range("H4").Select
ActiveSheet.Paste
Columns("E:E").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E4").Select
ActiveCell.FormulaR1C1 = "Artikel gekauft?"
Range("E5").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],gekauft.XLS!R2C6:R2000C6,1,FALSE)"
Range("E5").Select
Windows("ZCP7 Calculation tool.xlsm").Activate
Range("G4:G5").Select
Selection.Copy
Windows(wbAkt).Activate
Range("H4").Select
ActiveSheet.Paste
Cells.Select
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Windows("ZCP7 Calculation tool.xlsm").Activate
ActiveWindow.LargeScroll ToRight:=-1
Range("A4:B4").Select
Selection.Copy
Windows(wbAkt).Activate
Range("A4").Select
ActiveSheet.Paste
Range("A4").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A4:B4").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Selection.Font.Bold = True
With Selection
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells.Select
Cells.EntireColumn.AutoFit
Sheets(wsAkt).Select
Sheets(wsAkt).Name = "Preisanpassung - "
Range("A2").Select
ActiveCell.FormulaR1C1 = "Preisanpassung - "
Range("A2").Select
Selection.Font.Bold = True
Rows("5:5").Select
ActiveWindow.FreezePanes = True
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
'Deklararation von Variablen - vor 1. Verwendung im Makro - besser als 1. Zeilen im Makro
Dim Zeile_L As Long
Dim wks As Worksheet
'Start der Zeilen, die deine ersetzen
Set wks = ActiveSheet 'Tabellenblatt einer Variablen zuweisen
With wks
'Letzte ausgefüllte Zeile in Spalte H - ggf. andere Spalte wählen, um letzte _
ausgefüllte Zeile zu ermitteln
Zeile_L = .Cells(.Rows.Count, 8).End(xlUp).Row
If Zeile_L > 5 Then
'Bereich E5:H5 bis Listenende auffüllen
.Range(.Cells(5, 5), .Cells(5, 8)).AutoFill _
Destination:=.Range(.Cells(5, 5), .Cells(Zeile_L, 8))
'Bereich L5 bis Listenende auffüllen
.Cells(5, 12).AutoFill Destination:=.Range(.Cells(5, 12), .Cells(Zeile_L, 12))
'Bereich M5 bis Listenende auffüllen
.Cells(5, 13).NumberFormat = "0.00%"
.Cells(5, 13).AutoFill Destination:=.Range(.Cells(5, 13), .Cells(Zeile_L, 13))
End If
End With
'Ende der Zeilen, die deine ersetzen
'Letzte Zeile nur einmal am Ende eines Makros
End Sub

Anzeige
AW: Makro AutoFill Range anpassen
30.11.2015 10:05:00
fcs
Hallo Arthur,
bei all dem Gewusel von Spalten löschen, Spalten einfügen, und kopieren von Daten aus einer anderen Mappe ist für mich nicht erkennbar, ob in Spalte H bis zum Ende der Liste Daten in den Zellen stehen.
Wenn in Spalte nicht in allen Zellen Daten stehen, dann kann es passieren, dass die letzte Zeile mit Daten nicht korrekt ermittelt wird. 
'Letzte ausgefüllte Zeile in Spalte H - ggf. andere Spalte wählen, um letzte _
ausgefüllte Zeile zu ermitteln
Zeile_L = .Cells(.Rows.Count, 8).End(xlUp).Row

Statt 8 (entspricht Spalte H) muss dann eine Spalte gewählt werden, in der in jeder Zeile ein Wert vorhanden ist. Gibt es keine solche Spalte dann muss die letzte Spalte anders ermittelt werden.
Gruß
Franz
P.S. in deinem aufgezeichneten Makro wiederholen sich an einigen Stellen für das gleiche Object/Selection die Anweisungen. Betrifft Numberformat und PageSetUp.
Hier benötigst du nur die letzte Zeile bzw. den letzten Block. Die vorherigen Zeilen/Blöcke kannst du löschen. Doppelt gemoppelt hält besser gilt hier nicht.

Anzeige
AW: Makro AutoFill Range anpassen
30.11.2015 08:46:34
Arthur
Hallo Franz
Vielen Dank für deine Erklärung. Aber wenn ich nun haargenau diesen Text hier:
'Deklararation von Variablen - vor 1. Verwendung im Makro - besser als 1. Zeilen im Makro
Dim Zeile_L As Long
Dim wks As Worksheet
'Start der Zeilen, die deine ersetzen
Set wks = ActiveSheet 'Tabellenblatt einer Variablen zuweisen
With wks
'Letzte ausgefüllte Zeile in Spalte H - ggf. andere Spalte wählen, um letzte _
ausgefüllte Zeile zu ermitteln
Zeile_L = .Cells(.Rows.Count, 8).End(xlUp).Row
If Zeile_L > 5 Then
'Bereich E5:H5 bis Listenende auffüllen
.Range(.Cells(5, 5), .Cells(5, 8)).AutoFill _
Destination:=.Range(.Cells(5, 5), .Cells(Zeile_L, 8))
'Bereich L5 bis Listenende auffüllen
.Cells(5, 12).AutoFill Destination:=.Range(.Cells(5, 12), .Cells(Zeile_L, 12))
'Bereich M5 bis Listenende auffüllen
.Cells(5, 13).NumberFormat = "0.00%"
.Cells(5, 13).AutoFill Destination:=.Range(.Cells(5, 13), .Cells(Zeile_L, 13))
End If
End With
'Ende der Zeilen, die deine ersetzen
'Letzte Zeile nur einmal am Ende eines Makros
Einfüge wo meine mit dem Makroaufzeichner erstellten Schritte sind (die funktionieren) geht es nicht.
Excel zieht die Zeilen (Verknüpfungen) nicht bis zur letzten Zeile hinunter.
Hier das ganze Makro:
Sub Makro3()
' Makro3 Makro
wsAkt = ActiveSheet.Name
wbAkt = ActiveWorkbook.Name
Windows(wbAkt).Activate
Rows("4:4").Select
Selection.Delete Shift:=xlUp
Rows("3:3").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("A:D,I:L").Select
Range("I1").Activate
ActiveWindow.SmallScroll ToRight:=12
Range("A:D,I:L,U:V,X:X").Select
Range("X1").Activate
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Columns("K:K").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("K4").Select
ActiveCell.FormulaR1C1 = "ZCP7 in System"
Range("K5").Select
ActiveCell.FormulaR1C1 = _
"=IF(ISERROR(VLOOKUP(RC[-8],ZCP7.xlsx!R10C7:R2000C14,8,FALSE)),"""",((VLOOKUP(RC[-8], _
ZCP7.xlsx!R10C7:R2000C14,8,FALSE))))"
Range("K5").Select
Selection.NumberFormat = "0.0"
Selection.NumberFormat = "0.00"
Selection.NumberFormat = "0.000"
Windows("ZCP7.xlsx").Activate
Windows("ZCP7 Calculation tool.xlsm").Activate
Range("E4:F5").Select
Selection.Copy
Windows(wbAkt).Activate
Range("E4").Select
ActiveSheet.Paste
Range("E5:F5").Select
Application.CutCopyMode = False
Selection.NumberFormat = "0.000"
Selection.NumberFormat = "0.00"
Windows("ZCP7 Calculation tool.xlsm").Activate
Range("H4:I4").Select
Selection.Copy
Windows(wbAkt).Activate
Range("H4").Select
ActiveSheet.Paste
Columns("E:E").Select
Application.CutCopyMode = False
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("E4").Select
ActiveCell.FormulaR1C1 = "Artikel gekauft?"
Range("E5").Select
ActiveCell.FormulaR1C1 = "=VLOOKUP(RC[-2],gekauft.XLS!R2C6:R2000C6,1,FALSE)"
Range("E5").Select
Windows("ZCP7 Calculation tool.xlsm").Activate
Range("G4:G5").Select
Selection.Copy
Windows(wbAkt).Activate
Range("H4").Select
ActiveSheet.Paste
Cells.Select
Application.CutCopyMode = False
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Windows("ZCP7 Calculation tool.xlsm").Activate
ActiveWindow.LargeScroll ToRight:=-1
Range("A4:B4").Select
Selection.Copy
Windows(wbAkt).Activate
Range("A4").Select
ActiveSheet.Paste
Range("A4").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.ColorIndex = 0
.TintAndShade = 0
.Weight = xlThin
End With
Range("A4:B4").Select
Range(Selection, Selection.End(xlToRight)).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.249977111117893
.PatternTintAndShade = 0
End With
Selection.Font.Bold = True
With Selection
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Cells.Select
Cells.EntireColumn.AutoFit
Sheets(wsAkt).Select
Sheets(wsAkt).Name = "Preisanpassung - "
Range("A2").Select
ActiveCell.FormulaR1C1 = "Preisanpassung - "
Range("A2").Select
Selection.Font.Bold = True
Rows("5:5").Select
ActiveWindow.FreezePanes = True
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.7)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 100
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.PrintTitleRows = ""
.PrintTitleColumns = ""
End With
Application.PrintCommunication = True
ActiveSheet.PageSetup.PrintArea = ""
Application.PrintCommunication = False
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.75)
.BottomMargin = Application.InchesToPoints(0.75)
.HeaderMargin = Application.InchesToPoints(0.3)
.FooterMargin = Application.InchesToPoints(0.3)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = 1
.PrintErrors = xlPrintErrorsDisplayed
.OddAndEvenPagesHeaderFooter = False
.DifferentFirstPageHeaderFooter = False
.ScaleWithDocHeaderFooter = True
.AlignMarginsHeaderFooter = True
.EvenPage.LeftHeader.Text = ""
.EvenPage.CenterHeader.Text = ""
.EvenPage.RightHeader.Text = ""
.EvenPage.LeftFooter.Text = ""
.EvenPage.CenterFooter.Text = ""
.EvenPage.RightFooter.Text = ""
.FirstPage.LeftHeader.Text = ""
.FirstPage.CenterHeader.Text = ""
.FirstPage.RightHeader.Text = ""
.FirstPage.LeftFooter.Text = ""
.FirstPage.CenterFooter.Text = ""
.FirstPage.RightFooter.Text = ""
End With
Application.PrintCommunication = True
'Deklararation von Variablen - vor 1. Verwendung im Makro - besser als 1. Zeilen im Makro
Dim Zeile_L As Long
Dim wks As Worksheet
'Start der Zeilen, die deine ersetzen
Set wks = ActiveSheet 'Tabellenblatt einer Variablen zuweisen
With wks
'Letzte ausgefüllte Zeile in Spalte H - ggf. andere Spalte wählen, um letzte _
ausgefüllte Zeile zu ermitteln
Zeile_L = .Cells(.Rows.Count, 8).End(xlUp).Row
If Zeile_L > 5 Then
'Bereich E5:H5 bis Listenende auffüllen
.Range(.Cells(5, 5), .Cells(5, 8)).AutoFill _
Destination:=.Range(.Cells(5, 5), .Cells(Zeile_L, 8))
'Bereich L5 bis Listenende auffüllen
.Cells(5, 12).AutoFill Destination:=.Range(.Cells(5, 12), .Cells(Zeile_L, 12))
'Bereich M5 bis Listenende auffüllen
.Cells(5, 13).NumberFormat = "0.00%"
.Cells(5, 13).AutoFill Destination:=.Range(.Cells(5, 13), .Cells(Zeile_L, 13))
End If
End With
'Ende der Zeilen, die deine ersetzen
'Letzte Zeile nur einmal am Ende eines Makros
End Sub

Anzeige
AW: Makro AutoFill Range anpassen
24.11.2015 09:58:01
fcs
Hallo Arthur,
Sub AutoFill_E_to_H_and_L()
Dim Zeile_L As Long
Dim wks As Worksheet
Set wks = ActiveSheet
With wks
'Letzte ausgefüllte Zeile in Spalte H - ggf. andere Spalte wählen, um Letzte ausgefüllte Zeile  _
zu ermitteln
Zeile_L = .Cells(.Rows.Count, 8).End(xlUp).Row
If Zeile_L > 5 Then
'Bereich E5:H5 bis Listenende auffüllen
.Range(.Cells(5, 5), .Cells(5, 8)).AutoFill Destination:=.Range(.Cells(5, 5), .Cells( _
Zeile_L, 8))
'Bereich L5 bis Listenende auffüllen
.Cells(5, 12).AutoFill Destination:=.Range(.Cells(5, 12), .Cells(Zeile_L, 12))
End If
End With
End Sub

Gruß
Franz
Anzeige

301 Forumthreads zu ähnlichen Themen

Formel über VBA in Range.
Tom

Hi,
ich Versuch eine Summenformel
=SUMME(A3:A29)
verzweifelt über VBA dynamisch einzutragen.
Die Summe muss von A bis J eingetragen werden. Jedesmal mit dem entpsrechenden Buchstaben nicht immer mit A.
Hab das so versucht:
For k = 2 To 10 'Range(Cells(k, 29), Cells(...
13.08.2008 11:41:00
Thread-ID: 1001455
4 Beiträge
Anzeige
VBA - if anweisung mit variable
Thomas

Hallo,
ich habe ein blöds Problem und zwar habe ich folgendes If Abfrage in einer Forschleife in Pseudo:
Wenn A1 kleiner als A2 tu dies sonst tu das
VBA:
For i = 2 To 5 If "A" & i
Irgendwie trifft dort immer nur Else ein, ich glaube es liegt an der Bedingungsformulier...
16.10.2008 10:10:50
Thread-ID: 1016763
4 Beiträge
VBA Range Definition
Karen

Hallo Forum,
ich habe ein kleines Problem in meinem Makro.
Ich möchte eine Range abbilden, leider überträgt das Makro aber immer nur die Zeile 6.
For i = 2 To 256
If Cells(3, i).Value = datum Then
Range(Cells(6, i), Cells(40, i)).Copy
Selection.Copy
Cells(6, i + 1)...
22.12.2008 16:21:00
Thread-ID: 1034798
14 Beiträge
Anzeige
Range einer Variable zuweisen
Mario

Hallo
Ich wollte die selection.Range einer variablen zuweisen, damit ich danach die selection verändern kann und trotzdem noch weiss, was vorher selectiert war.
Ich habe schon folgende Varianten versucht:
Dim r As Range r = selection.Range ''Fehlermeldung r = Range(Cells(selection...
07.02.2009 08:42:07
Thread-ID: 1047988
21 Beiträge
VBA Abspeichern in variablen Ordner
Danomat

Hi,
folgendes Problem
In Zelle C1 steht der aktuelle Monat. Nun möchte ich die Datei als PDF abspeichern:
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"G:\Dokumente\Berichtswesen\Monatsreporting\02 Februar\Test.pdf" _
, Quality:=xlQualityStandard, IncludeDo...
13.03.2009 12:37:34
Thread-ID: 1059831
10 Beiträge
variable Zeilenanzahl kopieren, einfügen (VBA)
Alex

Hallo Leute,
In meiner Arbeitsmappe kopiere ich eine! Zeile (aus dem TabBlatt „Grundformular“) - via Doppelklick auf einen Namen in „Übersicht“ - in andere TabBlätter.
(das geht wunderbar)
Sieht jemand eine Möglichkeit ob/wie das ganze mit einer variablen Zeilenanzahl, die im „Grund...
18.03.2009 17:23:56
Thread-ID: 1061522
3 Beiträge
variabler SVerweis mit VBA
Jonathan

Hallo zusammen,
in einer Tabelle sind verschiedene Zeilen mit einem "x" in Spalte C markiert. Die Anzahl der "x" variert.
Nun versuche ich ein Makro zu erstellen, welches mir, wenn eine Zeile mit einem "x" markiert ist in
Spalte B einen SVerweis (Suchwert steht in Spalte A) einträg...
17.06.2009 14:28:57
Thread-ID: 1082250
3 Beiträge
Variable Liste in VBA
Diana

Liebes Forum,
ich habe ein Problem. Ich lese mit einem VBA-Makro Messwerte aus. Diese Messwerte werden über einen Namen auf einem anderen Rechner angesprochen. Derzeit gebe ich diese Namen (Adressen) direkt in das Makro ein.
strSQL = "SELECT k055z02_0.Zeit, k055z02_0.A00100001, ..., .....
14.08.2009 14:59:47
Thread-ID: 1096000
4 Beiträge
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge
3
4
3
13
4
20
9
2
2
3
2
1
12
3
16
6
1
4
2
3
2
4
6
14
2