VBA Copy cells from non-contiguous ranges to paste on another sheet

[RuiFlora]

Hello, I am trying to build a code that copy cells from non-contiguous ranges and paste the data on another sheet where the cells are contiguous. The ranges have more than one column but I just want to copy the data from one column (for example the first column). This is the code I have for now, but it gives me an error:

Sub CarCopy_Click()


Dim BrandCopy As Range
Set BrandCopy = Worksheets("Cars").Range("BrandCopy")
Dim ModelCopy As Range
Set ModelCopy = Worksheets("Cars").Range("ModelCopy")


Dim myRange As Range
With Sheet13
Set myRange = Union(.Range("BrandCopy"), .Range("ModelCopy"))
End With

With myRange
.Column(1).Select
End With

Selection.Copy
Sheets("Test").Select
Range("D11").Select
ActiveSheet.Paste


End Sub

Or, is there any way to copy the cells from a unique non-contiguous range? (ex: =Cars!$D$5:$AB$9,PC!$D$15:$AB$20) and paste them continuously in another sheet?

Hope someone can help me, i am really stuck with that
Many thanks in advance

 

[RuiFlora]

So, did you change it and try again? If you've changed your code, please re-post it.

Private Sub CommandButton2_Click()

Dim wsTest As Worksheet
Set wsTest = 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 = wsTest.Range("C14:CC14").Cells.Find(What:="", SearchOrder:=xlColumns, _
SearchDirection:=xlNext, LookIn:=xlValues).Column - 3

'set the destination in "Test" sheet
Set targetcell = Worksheets("Test").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

Like that it seems to be working well!!

Many thanks for your help and patience!

 

[GlennUK]

Like that it seems to be working well!!

Oh, is it working now?

 

[RuiFlora]

Oh, is it working now?

Yes it is. With the last code posted above, it is working how i meant to!
Thanks again!