AW: Teil von Zellenwert Importieren
10.12.2006 11:04:55
Zellenwert
Hi Bully,
Sub GetData(wks As Worksheet, lngStart As Long, lngEnd As Long)
Dim i As Long, k As Long
Application.ScreenUpdating = False
k = 10 'Startreihe
wks.Rows("10:65536").Delete 'Werte löschen
'Daten übertragen:
With Sheets("Daten")
For i = 2 To .Cells(.Rows.Count, 3).End(xlUp).Row
If .Cells(i, 20) >= lngStart And .Cells(i, 20) <= lngEnd Then
wks.Cells(k, 1) = wks.Cells(6, 4) 'Index
'wks.Cells(k, 2) = .Cells(i, 2) 'Bez.
wks.Cells(k, 2) = Left(.Cells(i, 2), 4)
wks.Cells(k, 3) = Right(.Cells(i, 2), 3)
wks.Cells(k, 5) = .Cells(i, 20) 'Datum
wks.Cells(k, 5).NumberFormat = "ddmmyyyy" 'Format
wks.Cells(k, 6) = .Cells(i, 24) 'Eber Rasse
wks.Cells(k, 7) = .Cells(i, 23) 'Eber-Zeichen
wks.Cells(k, 9) = .Cells(i, 26) 'KB-Art
wks.Cells(k, 10) = .Cells(i, 25) 'KB-Anzahl
k = k + 1
End If
Next
wks.Range("L1") = k - 10 'Anzahl
End With
'sortieren (aufsteigend=xlAscending; absteigend=xlDescending):
With wks
.Range("B10:AE" & .Cells(.Rows.Count, 3).End(xlUp).Row).Sort _
Key1:=.Range("D10"), _
Order1:=xlAscending, _
Key2:=.Range("C10"), _
Order2:=xlAscending, _
Header:=xlNo, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom, _
DataOption1:=xlSortTextAsNumbers, _
DataOption2:=xlSortNormal
End With
Application.ScreenUpdating = True
End Sub
Gruß
Reinhard
ps: Ich freue mich über eine Rückmeldung ob diese Antwort hilfreich war oder nicht..