In 2 Dateien suchen und Funde in Zellen schreiben
12.07.2018 21:57:13
Sabrina
gesucht und von den Funden der Wert aus der Ersten Spalte in die Datei Eingabe in Z1, Z2 .... geschrieben.
Mit dem Makro funktioniert das Wunderbar. Nun soll aber zuerst in der Datei Werte2.xls nach dem gleichen gesucht werden.
Und die Funde aus beiden Dateien geschrieben werden.
Ich habe With wksWerte2 ... vor With wksWerte eingefügt.
Aber dann kommt die Fehlermeldung im 2. With bei "arr(lngCounter, 1) = .Cells(lngRow, 1)" Außerhalb des Güligen Bereiches.
Kann mir jemand helfen?
LG Sabbel
lngZahl = Range("Geraetenummer")
If lngZahl > 0 Then
On Error Resume Next
Set wksWerte = Workbooks("Werte.xls").Sheets("Daten")
Set wksWerte2 = Workbooks("Werte2.xls").Sheets("Daten")
On Error GoTo 0
If wksWerte Is Nothing Then
Set wksWerte = Workbooks.Open(ThisWorkbook.Path & "\Werte.xls").Sheets("Daten")
End If
If wksWerte2 Is Nothing Then
Set wksWerte2 = Workbooks.Open(ThisWorkbook.Path & "\Werte2.xls").Sheets("Daten")
End If
With wksWerte
lngCount = Application.CountIf(.Columns(4), lngZahl)
If lngCount = 0 Then
MsgBox lngZahl & " nicht vorhanden.", vbOKOnly, "Gebe bekannt..."
Else
ReDim arr(1 To lngCount, 1 To 1)
For lngRow = 1 To .Cells(Rows.Count, 4).End(xlUp).Row
If .Cells(lngRow, 4) = lngZahl Then
lngCounter = lngCounter + 1
arr(lngCounter, 1) = .Cells(lngRow, 1)
End If
Next
End If
End With
With wksEingabe4
.Columns(26).ClearContents
.Cells(1, 26).Resize(lngCount) = arr
End With
End If