|
Hallo Gemeinde,
ich denke die Ursache meines Problems gefunden zu haben - allerdings noch keine Lösung dazu.
Wenn ich mit der Tastenkombination "Strg+Pfeiltasten" durch diese eine entsprechende Tabelle steuern möchte, springt der Cursor immer entweder zue komplett letzten Zelle des Blattes oder aber zur Beschriftung der Tabelle in Zeile 69. Das zeigt mir doch jetzt schon, dass auch die Funktion End(xlUp) keine Chance hat die letzte beschriebene Zelle in meiner angegebenen Range zu finden. --> mal abgesehen von der Zelle in Zeile 70, da ja die 69 (mit den Tabellen-Überschriften versehen) erkannt wird. Der erste ausgesuchte Bereich wird also sauber kopiert und die zwei weiteren folgenden werden dann brav ab Zeile 2500 eingefügt.
*Default*
Hier noch mal mein Code:
Sub verkürzte_KO_übertragen()
Application.ScreenUpdating = False
Dim loletzte As Variant
'löschen der Liste in Sheet "Berechnung"
Sheets(6).Range("W70:AG250000").ClearContents
'Stablage 1
'kopieren: Datum/Charge/Bemerkung
Sheets(3).Range("A5:C2500").Copy
Sheets(6).Activate
loletzte = IIf(IsEmpty(Range("W2500")), Range("W2500").End(xlUp).Row + 1, 2500)
Cells(loletzte, 23).PasteSpecial Paste:=xlPasteValues
'kopieren: Stablage 1
Sheets(3).Range("G5:I2500").Copy
Sheets(6).Activate
Cells(loletzte, 27).PasteSpecial Paste:=xlPasteValues
'Beschriften Stablage 1
Range(Cells(loletzte, 26), Cells(2500, 25).End(xlUp).Offset(0, 1)) = "1"
'Stablage 2
'kopieren: Datum/Charge/Bemerkung
Sheets(3).Range("A5:C2500").Copy
Sheets(6).Activate
loletzte = IIf(IsEmpty(Range("W2500")), Range("W2500").End(xlUp).Row + 1, 2500)
Cells(loletzte, 23).PasteSpecial Paste:=xlPasteValues
'kopieren: Stablage 2
Sheets(3).Range("K5:M2500").Copy
Sheets(6).Activate
Cells(loletzte, 27).PasteSpecial Paste:=xlPasteValues
'Beschriften Stablage 2
Range(Cells(loletzte, 26), Cells(2500, 25).End(xlUp).Offset(0, 1)) = "2"
'Stablage 3
'kopieren: Datum/Charge/Bemerkung
Sheets(3).Range("A5:C2500").Copy
Sheets(6).Activate
loletzte = IIf(IsEmpty(Range("W2500")), Range("W2500").End(xlUp).Row + 1, 2500)
Cells(loletzte, 23).PasteSpecial Paste:=xlPasteValues
'kopieren Stablage 3
Sheets(3).Range("O5:Q2500").Copy
Sheets(6).Activate
Cells(loletzte, 27).PasteSpecial Paste:=xlPasteValues
'Beschriften Stablage 3
Range(Cells(loletzte, 26), Cells(2500, 25).End(xlUp).Offset(0, 1)) = "3"
'Die "F" entfernen
'(diese Funktion sicherheitshalber integriert lassen!!!)
Application.ReplaceFormat.NumberFormat = "0.00"
Range("AA70:AC2500").Select
Selection.Replace What:="F", Replacement:=" ", lookat:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=True
'Fehlerhaft? - Deklarierung
Zeile = 70
With Sheets(6)
For Z = Zeile To 2500
If .Range("AA" & Z) = "" And .Range("AB" & Z) = "" And .Range("AC" & Z) = "" And .Range("W" & Z) = "" Then
Exit For
End If
If IsNumeric(.Range("AA" & Z)) And IsNumeric(.Range("AB" & Z)) And IsNumeric(.Range("AC" & Z)) _
And .Range("AA" & Z).Value > 240 And .Range("AB" & Z).Value > 300 And .Range("AC" & Z).Value > 5 Then _
.Range("AD" & Z) = "i. O." _
Else: _
.Range("AD" & Z) = "fehlerhaft"
Next
End With
'Übertragung abgeschlossen
Dim strText As String
strText = " abgeschlossen "
MsgBox "Übertragung " & strText
Application.ScreenUpdating = True
End Sub
Hat noch jemand von Euch eine Idee???
*grüße*
|