Zoeken op een woord (ander werkblad) en deel van een regel kopiëren

Status
Niet open voor verdere reacties.
R

Robert Smidt

Gebruiker
Lid geworden
26 mei 2009
Berichten
901
Beste Helpmij'ers,

Graag zou ik geholpen willen worden bij het volgende probleem dat ik naar lang zoeken niet op de site kon vinden.

Ik werk met twee werkbladen (Mutaties en Grootboekzoeker) waar het de bedoeling is wanneer ik iets in kolom D zet in het doelwerkblad (Mutaties), het systeem zoekt of de tekst ook voorkomt in het bronwerkblad (Grootboekzoeker) in kolom A. Wanneer deze de tekst heeft gevonden, dient het systeem alle gegevens te kopiëren. Een voorbeeld gaat als bijlage.

De code die ik nu gebruik werkt maar voor een deel.
Code: 
Target.Offset(, 2).Value = Sheets("Grootboekzoeker").Columns(1).Find(Target.Value).Offset(, 2).Value

Deze code kopieert alleen het woord dat twee posities rechts (in kolom C) staat en niet de volledige regel vanaf kolom C tot en met kolom M. Mijn wens is echter dat deze dus niet alleen voornoemd woord kopieert, maar alle gegevens (ook lege cellen) vanaf kolom C tot en met kolom M.

In het voorbeeld staat in de eerste regel vermeld hoe het systeem het moet vullen. In de tweede regel staat alleen de tekst die ik handmatig vul, de rest zal in dit geval door het systeem gevuld moeten worden.

Een antwoord zie ik met veel belangstelling tegemoet.
 

Bijlagen

  • Zoeken en kopieer voorbeeld.xlsm
    403,3 KB · Weergaven: 8
Kijk eens naar .Resize in plaats van .Offset
 
Dankjewel voor jouw snelle antwoord. Ik heb het gewijzigd in:
Code: 
Target.Offset(, 2).Value = Sheets("Grootboekzoeker").Columns(1).Find(Target.Value).Resize(, 5).Value

Het systeem kopieert nog steeds alleen het eerste woord. M.a.w. er verandert niets ten opzichte van de vorige code.
 
Ik keek net even in je voorbeeldocument, maar je macro staat er niet in.
 
Dat klopt, het betreft een enorm groot bestand met veel macro's. Ik heb het bestand aangepast om hier als voorbeeld te gebruiken.
 
Hierbij het bestand voorzien van de macro. Sorry voor het ongemak.
 

Bijlagen

  • Zoeken en kopieer voorbeeld.xlsm
    409 KB · Weergaven: 20
Je moet het wel goed wijzigen.

Code: 
Private Sub Worksheet_Change(ByVal Target As Range)
  If Target.Column = 4 Then
    Dim r As Range
    Application.EnableEvents = False
    ActiveSheet.Unprotect
    Set r = Sheets("Grootboekzoeker").Columns(1).Find(Target.Value)
    If Not r Is Nothing Then Target.Offset(, 2).Resize(, 11).Value = r.Offset(, 2).Resize(, 11).Value
    ActiveSheet.Protect AllowFiltering:=True
    Application.EnableEvents = True
  End If
End Sub
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan