Umformatierung per Makro

Hallo zusammen,
ich habe folgendes Problem:
Für eine interne Lagerbestandsauswertung muss ich monatlich einmal eine Exceltabelle die aus unserem Warenwirtschaftssystem als .csv Datei zur Verfügung gestellt wird, optisch etwas anspruchsvoller gestalten.
Außerdem muss der Gesamtwert als Summe ausgewiesen werden.
Die Dateien werden pro Lagerplatz erstellt und genau hier liegt momentan mein Problem. Ein Makro zu erstellen, bei welchem die einzelnen Formatierungen geändert werden ist kein Problem, aber ich kann das Makro nur für eine Datei verwenden, da im VB der Dateiname hinterleget ist. Wie kann ich das Makro allgemein formulieren? Der Dateiname darf nicht geändert werden!
Ich hänge euch mal die ursprüngliche Datei an und die Version, wie die Datei nach der _
Umformatierung aussehen soll. Außerdem noch den Makro-Code.


Sub Lagerbestand()
' Lagerbestand Makro
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Selection.Font.Bold = True
Range("A1").Select
ActiveWindow.LargeScroll ToRight:=0
Range("A1:G1").Select
Range("G1").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorDark1
.TintAndShade = -0.149998474074526
.PatternTintAndShade = 0
End With
Cells.Select
ActiveWorkbook.Worksheets("31.05.13vonN201bisN476").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("31.05.13vonN201bisN476").Sort.SortFields.Add Key:= _
Range("G2:G965"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption _
:=xlSortNormal
With ActiveWorkbook.Worksheets("31.05.13vonN201bisN476").Sort
.SetRange Range("A1:G965")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Columns("F:G").Select
Selection.Style = "Currency"
Range("G1").Select
ActiveWindow.LargeScroll Down:=0
Range("G1").Select
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").EntireColumn.AutoFit
Columns("D:D").EntireColumn.AutoFit
Columns("D:D").ColumnWidth = 14.86
Columns("E:E").EntireColumn.AutoFit
Columns("E:E").ColumnWidth = 10.71
Columns("F:F").EntireColumn.AutoFit
Columns("G:G").EntireColumn.AutoFit
Range("A1").Select
ActiveWindow.SmallScroll Down:=-11
Range("G2").Select
ActiveWindow.LargeScroll Down:=0
Range("A2:G11").Select
Range("G2").Activate
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 49407
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("A1").Select
Columns("C:C").ColumnWidth = 17.71
End Sub

https://www.herber.de/bbs/user/86430.xlsx
https://www.herber.de/bbs/user/86431.xlsx
Wäre super wenn mir jemand helfen könnte.
Gruß
Michael

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Lagerbestand() Dim LR& With ActiveWorkbook.Sheets(1) .Rows("1:1").Delete Shift:=xlUp .Rows("1:1").Font.Bold = True LR = .Cells(Rows.Count, 1).End(xlUp).Row 'letzte Zeile der Spalte A With .Range("A1:G1").Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .ThemeColor = xlThemeColorDark1 .TintAndShade = -0.149998474074526 .PatternTintAndShade = 0 End With With .Sort .SortFields.Clear .SortFields.Add Key:=Range("G:G"), SortOn:=xlSortOnValues, _ Order:=xlDescending, DataOption:=xlSortNormal .SetRange Range("A1:G" & LR) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With .Range("F" & LR + 2).Formula = "Summe" .Range("G" & LR + 2).Formula = "=SUM(G2:G" & LR & ")" .Columns("F:G").Style = "Currency" .Columns("B:G").EntireColumn.AutoFit .Columns("C:C").ColumnWidth = 17.71 .Columns("D:D").ColumnWidth = 14.86 .Columns("E:E").ColumnWidth = 10.71 With .Range("A2:G" & LR).Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 49407 .TintAndShade = 0 .PatternTintAndShade = 0 End With End With End Sub

Beliebteste Forumthreads (12 Monate)

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread