Dim i
For i = 1 To Worksheets("Tabellenname").Range("A65536").End(xlUp).Row
'"Tabellenname" und "Range("A....")" ggf. ändern
   If Len(Worksheets("Tabellenname").Range("A" & i).Value) = 7 Then
      If Mid(Worksheets("Tabellenname").Range("A" & i).Value, 5) > "000" And _
         Mid(Worksheets("Tabellenname").Range("A" & i).Value, 5) < "999" Then
         Worksheets("Tabellenname").Range("C" & i).Value = Worksheets( _
           "Tabellenname").Range("A" & i).Value
         ' kopiert den Eintrag aus "A" in die Spalte "C"
      End If
   End If
Next

Uli

Wissen ist Macht; nichts wissen macht auch nichts!