Erich hatte mir freundlicherweise damit Unterstützt läuft auch.
Nur wenn der 1. Datensatz kopiert wurde kommt eine Fehlermeldung.
https://www.herber.de/bbs/user/73198.xls
mfg kurt p
Sub NummernAzuE()
Dim arrA, arrE(), lngE As Long, lngN As Long, zz As Long
lngE = Cells(Rows.Count, 5).End(xlUp).Row - 3
Select Case lngE
Case 0
Case 1
Cells(4, 1) = 1
Case Else
If lngE > 0 Then
arrA = Cells(4, 5).Resize(lngE)
ReDim arrE(1 To lngE)
For zz = 1 To UBound(arrA)
If Application.IsNumber(arrA(zz, 1)) Then
lngN = lngN + 1
arrE(zz) = lngN
End If
Next zz
Cells(4, 1).Resize(lngE) = Application.Transpose(arrE)
End If
End Select
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort und: Schönen Sonntag noch!
Sub NummernAzuE()
Dim arrA, arrE(), lngE As Long, lngN As Long, zz As Long
lngE = Cells(Rows.Count, 5).End(xlUp).Row - 3
Select Case lngE
Case 0
Case 1
If Application.IsNumber(Cells(4, 5)) Then Cells(4, 1) = 1
Case Else
If lngE > 0 Then
arrA = Cells(4, 5).Resize(lngE)
ReDim arrE(1 To lngE)
For zz = 1 To UBound(arrA)
If Application.IsNumber(arrA(zz, 1)) Then
lngN = lngN + 1
arrE(zz) = lngN
End If
Next zz
Cells(4, 1).Resize(lngE) = Application.Transpose(arrE)
End If
End Select
End Sub
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort