|
Hallo Leute!
Da ich mit eurer Hilfe und eurem Know-How schneller voran komme, ohne zu verzweifeln und ohne stundenlanger Suche nach dem Fehler im Code, bräuchte ich eure Hilfe für diese zwei Codes, an denen ich bereits einige Stunden rumprobiere.
1.Code: Dieser soll die LOT- und die SAP-Nr. von der Tabelle 1 in die Tabelle 3 kopieren. Dies hat auch eine zeit lang echt gut geklappt. Leider geht es nicht mehr und ich weiß nicht woran es liegt. Ich habe nämlich versucht, dass die Nummern nicht immer vom Anfang der Tabelle 1 immer in die Tabelle 3 kopiert werden, sondern lediglich die letzten eingefügten Nummern in der Tabelle 1. Die Tabelle 1 wird praktisch immer mit neuen Zeilen erweitert und der Code soll die neuen Zeilen in die Tabelle 3 übernehmen.
'LOT und SAP Nr. von Tabelle 1 in die Tabelle 3 kopieren
Dim zi As Integer
Dim j As Integer
Dim LOT As Long
Dim SAP As Long
zi = 2
j = 2
If t1.Cells(2, 7) <> "" Then
LOT = t1.Cells(2, 7)
t3.Cells(j, 4) = LOT
End If
Do While t1.Cells(zi, 1) <> ""
If t1.Cells(zi, 9) <> "" Then
SAP = t1.Cells(zi, 9)
t3.Cells(j, 5) = SAP
LOT = t1.Cells(zi, 7)
t3.Cells(j, 4) = LOT
If LOT > 0 Then
j = j + 1
End If
End If
zi = zi + 1
Loop
2.Code: Hier ist es anders rum. Die Tabelle 3 hat die LOT- und SAP-NR. aus der Tabelle 1 und dazu wird die Menge (Spalte F-H) ergänzt. Diese soll zu den Nummern in die Tabelle 1 zugeordnet werden. Der Code führt es nicht ganz aus. Ich habe versucht, dass es nur ab den letzten 5 Nummern überprüft (beginnt) und nicht immer wieder die komplette Tabelle (damit es nicht hängt, wenn die Tabelle deutlich größer wird).
Er soll praktisch aus der Tabelle 3, die letzten 5 Zeilen der Spalten F-H kopieren und zugehörig zu den Nummern in die Tabelle 1 kopieren.
'Übernehme die Menge aus der Tabelle 3 in die Tabelle 1
Dim rngQuelle As Range
Dim rngZiel As Range
Dim g As Integer
g = t1.Cells(Rows.Count, 7).End(xlUp).Row - 5
Dim mg As Integer
mg = t3.Cells(Rows.Count, 6).End(xlUp).Row - 5
Do While t1.Cells(g, 8) <> ""
With t1
For Each rngZiel In .Range("G1:G" & .Cells(.Rows.Count, 2).End(xlUp).Row)
On Error Resume Next
Set rngQuelle = t3.Range("D:D").Find(What:=rngZiel, LookAt:=xlPart)
On Error GoTo 0
If Not rngQuelle Is Nothing Then
rngQuelle.Offset(mg, 2).Resize(5, 3).Copy
rngZiel.Offset(g, 4).Resize(5, 3).PasteSpecial
End If
Next rngZiel
Exit Do
End With
Loop
Ich hoffe ihr könnt mir helfen!
VG
|