Aus einem anderen Arbeitsblatt kopieren, kopieren und einfügen

Question

Ich bin neu in VBA excel. Ich plane, den übereinstimmenden Wert von einer Datenbank zu finden und die Daten zu einem anderen Blatt zu kopieren. Die folgenden Codes funktionieren, wurden aber nach einigen Versuchen nicht mehr ausgeführt. Ist meine Excel-Datei beschädigt? Oder Code ist falsch.

Sub match() 
Dim lastrow As Long 
    lastrow = ThisWorkbook.ActiveSheet.Cells(ThisWorkbook.ActiveSheet.Rows.Count, "A").End(xlUp).Row 
Dim searchlist As Range 
    Dim rcell As Range, sValue As String 
    Dim lcol As Long, cRow As Long 
    Dim dRange As Range, sCell As Range 
    Dim d As Long 

    Set searchlist = Sheets("sheet2").Range("a5:a" & lastrow) 

    Set dRange = Sheets("Database").Range("a1:a" & lastrow) 
    For Each rcell In searchlist 
     lcol = 1 

     For Each sCell In dRange 
      If InStr(1, sCell.Value, rcell.Value) And Trim(rcell.Value) <> "" Then 


       For d = 1 To 22 
       rcell.Offset(0, lcol).Value = sCell.Offset(0, d).Value 
       lcol = lcol + 1 
      Next 
      End If 
     Next 
    Next 

End Sub 

Answer 1

Bitte ersetzen Sie diesen Code:

If InStr(1, sCell.Value, rcell.Value) And Trim(rcell.Value) <> "" Then 

zu

If InStr(1, sCell.Value, rcell.Value) > 0 And Trim(rcell.Value) <> "" Then 

Hope this Hilfe.