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

 

[GlennUK]

Can you explain this in detail:

The ranges have more than one column but I just want to copy the data from one column

I can't see that you are attempting that at all. Or am I misunderstanding something?

Also, are you just wanting the values taken across, or formatting also? ( do you really need to copy and paste, or will setting cells in sheet Test to the values in the source range be sufficient? )

 

[RuiFlora]

Can you explain this in detail:


I can't see that you are attempting that at all. Or am I misunderstanding something?

Also, are you just wanting the values taken across, or formatting also? ( do you really need to copy and paste, or will setting cells in sheet Test to the values in the source range be sufficient? )

I just want to take the values. Not formatting them. i give you an example of data to better understanding.

[TABLE="class: grid, width: 500"]
<tbody>[TR]
[TD][/TD]
[TD]A[/TD]
[TD]B[/TD]
[TD]C[/TD]
[/TR]
[TR]
[TD]1[/TD]
[TD]10[/TD]
[TD]15[/TD]
[TD]10[/TD]
[/TR]
[TR]
[TD]2[/TD]
[TD][/TD]
[TD][/TD]
[TD]2[/TD]
[/TR]
[TR]
[TD]3[/TD]
[TD]2[/TD]
[TD]111[/TD]
[TD]51[/TD]
[/TR]
[TR]
[TD]4[/TD]
[TD]51[/TD]
[TD]60[/TD]
[TD]30[/TD]
[/TR]
[TR]
[TD]5[/TD]
[TD]30[/TD]
[TD]31[/TD]
[TD]8[/TD]
[/TR]
[TR]
[TD]6[/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[/TR]
[TR]
[TD]7[/TD]
[TD]8[/TD]
[TD]88[/TD]
[TD][/TD]
[/TR]
</tbody>[/TABLE]

In that case, my range is for example: =CAR!A1:B1,A3:B5,A8:B8. What I pretend is to copy just the column 1 of the (non contiguous) range that I refer, to another place, continuously, like I put in column C.

 

[GlennUK]

Are you just skipping blanks in the first column, or is that just your example?

 

[RuiFlora]

Are you just skipping blanks in the first column, or is that just your example?

It is just an example. Normally, they have values inside.

 

[GlennUK]

Try replacing:

With myRange
.Column(1).Select
End With

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

with:

Set targetcell = Worksheets("Test").Range("D11")
For Each carblock In myRange.Areas
    targetcell.Resize(carblock.Rows.Count).Value = carblock.Resize(, 1).Value
    Set targetcell = targetcell.Offset(carblock.Rows.Count)
Next

 

[RuiFlora]

Try replacing:

With myRange
.Column(1).Select
End With

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

with:

Set targetcell = Worksheets("Test").Range("D11")
For Each carblock In myRange.Areas
    targetcell.Resize(carblock.Rows.Count).Value = carblock.Resize(, 1).Value
    Set targetcell = targetcell.Offset(carblock.Rows.Count)
Next

Thanks a lot! it is working! However, is it possible to copy and paste, instead of to Range("D11"), to be at the first empty column to the right? Each time i execute the code, it will copy to the next empty column. It would be great!

 

[RuiFlora]

I adapted the code you sent me. It is copying but not the way I pretend. I have two combobox, and in the second one I select a value, which is related to a column. That is where I "select" the column that I want to copy to "Test". The problem is that in the way the code is built, it is copying only the first column, and not selecting, depending on what I select in the second combobox. i dont know if the problem is with the .Resize command. I hope my explanation is understandable.



Private Sub CommandButton2_Click()


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


Dim lColumn As Integer
Dim Deliver As String


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


'First selection
If ComboBox1.Value = "BMW" Then

'get the value of second selection
Deliver = ComboBox2.Value

'get the column com second selection
colNum = WorksheetFunction.Match(Deliver, ActiveWorkbook.Sheets("BMW").Range("D3:S3"), 0)

'get the colum 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(, 1).Value
Set targetcell = targetcell.Offset(copy.Rows.Count)
Next

End If


End Sub

 

[GlennUK]

Sorry, but I can't follow this:

... it is copying only the first column, and not selecting, depending on what I select in the second combobox...

 

[RuiFlora]

Sorry, but I can't follow this:

Sorry to be not clear in the explanation.
What meant was that:
The code I posted above is for a button in a userForm. In this userForm I have a combobox to choose what i want to copy from another sheet, per column (in this case models of BMW). Those models are in specific columns (ex: A, B, C, etc), and this is what i want to copy.

The code you posted is copying data, but only for column A of the range. I want to be able that, depending on the model i choose from the combobox, copying the corresponding column.