Macro: Find-copy-past

[Hugoderuiter]

Ola,

Ik ben opzoek naar een VB code/macro om;
Naam intypen in een cell, deze naam vervolgens laten opzoeken in een data lijst en vervolgens meerdere aan de naam gekoppelde rijen te selecteren en vervolgens te kopieren naar een niewe sheet.

Heeft iemand een idee?
Alvast bedankt!

 

[Cobbe]

Nog nooit gehoord van VERT.ZOEKEN?

Cobbe

 

[zapatr]

Ik ben opzoek naar een VB code/macro om;
Naam intypen in een cell, deze naam vervolgens laten opzoeken in een data lijst en vervolgens meerdere aan de naam gekoppelde rijen te selecteren en vervolgens te kopieren naar een niewe sheet.

Dat kan bijvoorbeeld op de volgende manier:
Doorloop de lijst (bv kolom A) om te kijken of de door jou ingetypte naam daarin voorkomt (dat doorlopen kan op verschillende manieren: for-fext, do-while, do-until, while-wend, enz. Kijk in Excel-vba-helpfile bij die opdrachten, daar staan voorbeelden bij die je zo kunt gebruiken). Zodra in kolom A eenzelfde waarde wordt gevonden als de ingevoerde waarde, geef je een copy-opdracht om de betreffende rij naar een ander werkblad te kopiëren (kijk in de helpfile bij Copy of doorzoek dit forum).
Dat is het beginsel, door ermee te beginnen, te proberen, en te zoeken, leer je het automatisch.

 

[Hugoderuiter]

Ik heb nu de onderstaande code, welk goed werkt. Maar ik zou graag het woord 'BAG' willen veranderen door een cel, waar een willekeurig woord ingevuld kan worden??
Alvast bedankt voor de informatie tot nu toe!


Sub SearchForString()

Dim LSearchRow As Integer
Dim LCopyToRow As Integer

On Error GoTo Err_Execute

'Start search in row 4
LSearchRow = 4

'Start copying data to row 2 in sheet1 (row counter variable)
LCopyToRow = 2

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

'If value in column B = "BAG", copy entire row to Sheet1
If Range("B" & CStr(LSearchRow)).Value = "BAG" Then

'Select row in Data to copy
Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
Selection.Copy

'Paste row into Sheet1 in next row
Sheets("Sheet1").Select
Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
ActiveSheet.Paste

'Move counter to next row
LCopyToRow = LCopyToRow + 1

'Go back to Data to continue searching
Sheets("Data").Select

End If

LSearchRow = LSearchRow + 1

Wend

'Position on cell A3
Application.CutCopyMode = False
Range("A3").Select

MsgBox "All matching data has been copied."

Exit Sub

Err_Execute:
MsgBox "An error occurred."

End Sub

 

[Roncancio]

Vervang "BAG" door Range("A1").Value

Met vriendelijke groet,


Roncancio

 

[Wigi]

Hugo

Je gebruikt in je code al de code om iets uit te lezen uit een cel, nl. op deze regel:

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

Dan kan het toch niet zo onoverkomelijk zijn om dit aan te passen.

Wigi

 

[Roncancio]

Hugo

Je gebruikt in je code al de code om iets uit te lezen uit een cel, nl. op deze regel:

While Len(Range("A" & CStr(LSearchRow)).Value) > 0

Dan kan het toch niet zo onoverkomelijk zijn om dit aan te passen.

Wigi

Iets zegt mij dat TS deze code niet zelf heeft geschreven.

Met vriendelijke groet,


Roncancio

 

[Wigi]

Iets zegt mij dat TS deze code niet zelf heeft geschreven.

Je zit er recht op volgens mij

 

[Hugoderuiter]

Klopt

Klopt, ik heb deze rechtstreeks van internet
Heb zelf niet zoveel ervaring met vba, geen probleem toch?

Maar als ik BAG vervang door Range("A1").Value, werkt het nog niet?
'If value in column B = "Range("A1").Value", copy entire row to Sheet1
If Range("A1" & CStr(LSearchRow)).Value = "Range("A1").Value" Then

Onderste zin kleurt rood, met melding 'expected then or goto'

 

[Roncancio]

Klopt, ik heb deze rechtstreeks van internet
Heb zelf niet zoveel ervaring met vba, geen probleem toch?

Maar als ik BAG vervang door Range("A1").Value, werkt het nog niet?
'If value in column B = "Range("A1").Value", copy entire row to Sheet1
If Range("A1" & CStr(LSearchRow)).Value = "Range("A1").Value" Then

Onderste zin kleurt rood, met melding 'expected then or goto'

Je moet de quotes weghalen. Dus:
If Range("A1" & CStr(LSearchRow)).Value = Range("A1").Value Then

Met vriendelijke groet,


Roncancio

 

[Hugoderuiter]

Ontzettend bedankt!!

Hij werkt wel, maar nog niet naar behoren.
Ik ga er denk ik morgen weer op mijn gemak naar kijken.

Nogmaals bedankt,

Vriendelijk groet

Hugo