VBA verticaalzoeken probleem

[HWV]

Beste,

In de bijlage mijn aangepaste bestand (met kolommen uit mijn orginele bestand) waar verticaalzoeken niet goed gaat, ik gebruik onderstaande code!

Sub VerticaalZoeken()

On Error Resume Next
    For j = 2 To Sheets("Inkooporder").Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("Inkooporder").Columns(1).Find(Sheets("Database").Cells(j, 1).Value)
      .Offset(, 9).Copy
      Sheets("Database").Cells(j, 28).PasteSpecial xlPasteValues
      .Offset(, 9).Copy
      Sheets("Database").Cells(j, 45).PasteSpecial xlPasteValues
      .Offset(, 10).Copy
      Sheets("Database").Cells(j, 27).PasteSpecial xlPasteValues
    End With
  Next
End Sub

Hij vult wel gegevens op scheets database maar niet op de juiste regel en hij vult het gehele werkblad tot aan het einde

Ik hoop dat dit duidelijk is en iemand kan vertellen waarom dit niet goed gaat

Groet Henk

Bekijk bijlage helpmij_verticaalzoeken.xlsm

 

[HWV]

Vreemd verhaal

Sub VerticaalZoeken()

With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

On Error Resume Next
   For j = 3 To Sheets("Database").Cells(Rows.Count, 1).End(xlUp).Row
    With Sheets("Inkooporder").Columns(1).Find(ActiveSheet.Cells(j, 1).Value)
      Sheets("Database").Cells(j, 28) = .Offset(, 9)
      Sheets("Database").Cells(j, 45) = .Offset(, 10)
      Sheets("Database").Cells(j, 27) = .Offset(, 10)
    End With
  Next

With Application
    .DisplayAlerts = True
    .ScreenUpdating = True
End With

End Sub

Hiermee is het opgelost

Henk

 

[VenA]

Probeer het zo eens

Sub VenA()
  ar = Sheets("Inkooporder").Cells(14, 1).CurrentRegion.Resize(, 11)
  For j = 2 To UBound(ar)
    With Sheets("Database").Cells(Application.Match(ar(j, 1), Sheets("Database").Columns(1), 0), 27)
      .Resize(, 2).Value = Array(ar(j, 11), ar(j, 10))
      .Offset(, 18).Value = ar(j, 10)
    End With
  Next j
End Sub

 

[HWV]

Top

Bedankt voor ook weer een oplossing VenA

Groet Henk