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