VBA Find and copy multiple ocurrances of a value

[RuiFlora]

Hi.
I am trying to build a code that copy cells from non-contiguous ranges and paste on another sheet continously. The ranges have multiple columns but I just want to copy the data from a specific column (Which I select depending on a combobox value). This is the code I have for now:

Private Sub CommandButton2_Click()

Dim ws As Worksheet
Set ws = Worksheets("Test")

Dim lColumn As Integer
Dim Model As String

Dim copy As Range
Dim HistCopy As Range
Set HistCopy = Worksheets("BMW").Range("HistCopy")

'Get the value of the model (in BMW sheet) i want to copy
Model = ComboBox2.Value

'Search for the column of the model selected in "BMW" sheet
colNum = WorksheetFunction.Match(Model, ActiveWorkbook.Sheets("BMW").Range("D3:S3"), 0)

'get the colum number of the the first empty cell in "Test"
lColumn = ws.Range("C14:CC14").Cells.Find(What:="", SearchOrder:=xlColumns, _
SearchDirection:=xlNext, LookIn:=xlValues).Column - 3

'set the destination in "Test" sheet
Set targetcell = ws.Cells(11, lColumn + 3)

'Copy data from all areas in HistCopy range and paste in "Test" sheet

For Each copy In HistCopy.Areas
targetcell.Resize(copy.Rows.Count).Value = copy.Resize(0, colNum - 1).Value
Set targetcell = targetcell.Offset(copy.Rows.Count)
Next

End Sub

---------------------------------------------------------------------------

This code is working well (select and copy). However, it is just copying the first match of "Model", and there are more than one. I would like to copy ALL columns that matches with Model. I guess the problem must be related with the WorksheetFunction.Match syntax, but i cant find how.

Hope someone could help me in this.

Cheers

 

[sijpie]

Yes. You should not use Match her. What you want to do is use the Range.Find() method.

So if you want to find Model in the columns, than you get the first result with

dim rFind as Range, rFirst as Range

Set rFirst= ActiveWorkbook.Sheets("BMW").Range("D3:S3").Find(What:=Model, SearchOrder:=xlColumns, _
SearchDirection:=xlNext, LookIn:=xlValues, Lookat:=xlWhole)

set rFound=rFirst

do while rFound not is nothing ' Model found

   ' get the extent of the range and do your copy
   ...
   ' now find next occurrence
   set rFound=ActiveWorkbook.Sheets("BMW").Range("D3:S3").FindNext(After:=rFound)
   ' check that we don't end up at first,else endless loop
   if rfirst.address=rFind.address then exit do 
loop

 

[RuiFlora]

Yes. You should not use Match her. What you want to do is use the Range.Find() method.

So if you want to find Model in the columns, than you get the first result with

dim rFind as Range, rFirst as Range

Set rFirst= ActiveWorkbook.Sheets("BMW").Range("D3:S3").Find(What:=Model, SearchOrder:=xlColumns, _
SearchDirection:=xlNext, LookIn:=xlValues, Lookat:=xlWhole)

set rFound=rFirst

do while rFound not is nothing ' Model found

   ' get the extent of the range and do your copy
   ...
   ' now find next occurrence
   set rFound=ActiveWorkbook.Sheets("BMW").Range("D3:S3").FindNext(After:=rFound)
   ' check that we don't end up at first,else endless loop
   if rfirst.address=rFind.address then exit do 
loop

It worked. Thank you very much!
Cheers