AW: Range("A3:<ende verwendete Spalten>:3).s
06.05.2023 22:07:13
Wolle
Eine Sache mus ich noch anpassen.
Ich habe eine Tabelle mit immer gleicher Spaltenanzahl aber mit variabler Reihenanzahl.
Diese Aussage stimmt nicht ganz.
Meine Ursprungsdatei ist eine csv und dort sind leider untereinander verschiedene Bereiche die jeder Bereich für sich eine unterschiedliche Spaltenanzahl hat.
Als erstes unterteile ich die einzelnen Bereiche in unterschiedliche Arbeitsblätter kopiere und dann Formatiere, dadurch hat natürlich jedes Arbeitsblatt ebenfalls eine variable Spaltenanzahl.
Das Unterteilen der Ursprungsdatei habe ich schon hinbekommen, es geht jetzt halt um das Formatieren der einzelnen Blätter.
Hir mal mein bishereiger Code. Ist sicherlich nicht perfekt aber funktioniert soweit wie ich es brauche.
Sub Makro1()
'
' Makro1 Makro
'
'
Dim z, anf, AnzSheets, rng, LetzteSpalte
anf = 1
AnzSheets = 1
For z = anf To 5000
If Cells(z, 1) = "Gesamt" Then
Set rng = Range("A1" & ":U" & z)
rng.Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Name = Range("A1").FormulaR1C1
ActiveSheet.UsedRange.Select
With Selection.Font
.Name = "Arial"
.Size = 11
End With
Range("A1").Select
Selection.Font.Bold = True
With Selection.Font
.Name = "Arial"
.Size = 16
End With
Rows("2:2").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ActiveSheet.UsedRange.EntireColumn.AutoFit
ActiveSheet.UsedRange.Select
'---------Hier kommt der zusätzliche Code zum Formatieren rein----->>>>>>
Sheets(1).Select
Selection.Delete Shift:=xlUp
Rows("1:1").Select
Selection.Delete Shift:=xlUp
anf = 1
z = 1
If Cells(1, 1).Value Like "*tunden*" Then
z = 5000
Set rng = Range("A1" & ":U" & ActiveSheet.UsedRange.Rows.Count)
rng.Select
Selection.Copy
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Paste
Application.CutCopyMode = False
ActiveSheet.Name = "Überstunden"
ActiveSheet.UsedRange.EntireColumn.AutoFit
Application.DisplayAlerts = False
Sheets(1).Delete
Application.DisplayAlerts = True
End If
End If
Next z
End Sub
Gurß, Wolle
