Option Explicit
Sub Formatieren()
FormatiereSpalte "A", 2
End Sub
Function FormatiereSpalte(Spalte As String, StartZeile As Double)
Dim LetzteZeile As Double
Dim LetztesFormat As Double
Dim Counter1 As Double
Dim Counter2 As Double
Dim Zelle As String
LetzteZeile = WorksheetFunction.CountA(ActiveSheet.Range(Spalte & ":" & Spalte))
LetztesFormat = WorksheetFunction.CountA(Sheets("Formatvorlage").Range(Spalte & ":" & Spalte))
For Counter1 = StartZeile To LetzteZeile + StartZeile
Zelle = ActiveSheet.Range(Spalte & Counter1).Value
Counter2 = 0
Do
Counter2 = Counter2 + 1
If Zelle Like Sheets("Formatvorlage").Range(Spalte & Counter2).Value Then Exit Do
Loop Until Counter2 > LetztesFormat
Sheets("Formatvorlage").Range(Spalte & Counter2).Copy
ActiveSheet.Range(Spalte & Counter1).PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Next Counter1
End Function
Bereits jetzt fällt auf, das es nicht das Schnellste sein wird. Welche Oprimierungen sind noch möglich?
Danke
Piecha