AW: Werte werden aus andere Liste nit übertrage
12.06.2018 14:06:42
fcs
Hallo Hendl,
ich hab deinen Code mal etwas übersichtlicher gestaltet, indem ich für die geladene Arbeitsmappe und die beiden Tabellenblätter Variablen eingeführt habe.
Offensichtlich möglicher Fehler:
in Zeile
For i = 2 To Worksheets(1).UsedRange.Rows.Count
fehlt evtl. die Arbeitsmappe zum Worksheet. Sollte wohl besser so sein:
For i = 2 To ThisWorkbook.Worksheets(1).UsedRange.Rows.Count
Wenn dies nicht der Fehler ist, dann musst du die Logik in den If-Prüfungen uberprüfen.
Evtl. sind die Zelen, die du auf "leer" prüfst nicht leer sondern enthalten einen Leerstring.
If IsEmpty(ThisWorkbook.Worksheets(1).Cells(i, 13)) = False ...
musst du dann ersetzen durch
If Not ThisWorkbook.Worksheets(1).Cells(i, 13)) = "" ...
Gruß
Franz
'Überarbeiteter Code
Public Sub test()
Dim i, j As Integer
Dim wkbRep_TA As Workbook, wksRep_TA1 As Worksheet
Dim wksZ1 As Worksheet
'On Error GoTo Fehler
Application.DisplayAlerts = False 'ausschalten
'**Bildschirm ausblenden
Application.ScreenUpdating = False 'Bildschirm auschalten
Application.StatusBar = "Workordernummern werden aktualisiert. Dies kann einige Minuten dauern." _
_
Set wksZ1 = ThisWorkbook.Worksheets(1)
'öffne jetzt die Datei *************************************
Set wkbRep_TA = Workbooks.Open(Filename:=ThisWorkbook.Path & "\Rep_TA.xlsx", Notify:=False, _
ReadOnly:=True)
Set wksRep_TA1 = wkbRep_TA.Worksheets(1)
For i = 2 To wksZ1.UsedRange.Rows.Count
For j = 2 To wksRep_TA1.UsedRange.Rows.Count
If IsEmpty(wksZ1.Cells(i, 13)) = False And IsEmpty(wksZ1.Cells(i, 12)) Then
If InStr(1, wksZ1.Cells(i, 13).Text, wksRep_TA1.Cells(j, 2).Text, _
vbTextCompare) 0 Then
If wksRep_TA1.Cells(j, 6) = "" Then ' hier wird gefragt ob eine _
Workordernummer exestiert
wksZ1.Cells(i, 12).Value = wksRep_TA1.Cells(j, 1)
Else
wksZ1.Cells(i, 12) = wksRep_TA1.Cells(j, 6)
End If
End If
End If
Next j
Next i
wkbRep_TA.Close savechanges:=False
'On Error GoTo Fehler
Application.DisplayAlerts = True 'ausschalten
'**Bildschirm ausblenden
Application.ScreenUpdating = True 'Bildschirm auschalten
Application.StatusBar = False
MsgBox ("fertig")
End Sub