Copy and paste specific ranges

[caudillo]

Hello,
I am trying to build a code in Excel VBA to copy specific ranges from one sheet and paste them to specific area in another sheet. Every time I copy the specific ranges from the first sheet they have to be pasted in the next empty column of the specific area. The code is as folows:


Sub copyandpaste()
Dim sws As Worksheet
Dim dws As Worksheet

Set sws = Sheets("Sheet1")
Set dws = Sheets("Sheet2")


Sheets("Sheet1").Select
Range("C10:C11").Select
Selection.Copy
dws.Select
Range("B6:B7").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Sheets("Sheet1").Select
Range("H20:H40").Select
Selection.Copy
dws.Select
Range("B9").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

dws.Activate
End Sub

Every time I try to execute the code the data are pasted in the same B column. Is there a way to make it find the next empty column (C, D, E and so on) and paste the data there?
Any help would be really appreciated.
Thanks

[Aussiebear]

Maybe try

Sub copyandpaste()Dim sws As Worksheet
Dim dws As Worksheet
Set sws = Sheets("Sheet1")
Set dws = Sheets("Sheet2")
Sheets("Sheet1").Range("C10:C11").Copy
Sheets("Sheet2").Cells(10, .ColumnsCount).Left(xlToLeft).Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Sheets("Sheet1").Range("H20:H40").Copy
Sheets("Sheet2").Cells(20, .ColumnsCount).Left(xlToLeft).Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
dws.Activate
End Sub

[caudillo]

Thank you Aussiebear.
I will definitely try your suggestion!
Hope all will go well.

[snb]

Strange:


Set sws = Sheets("Sheet1")
Sheets("Sheet1").Range("C10:C11").Copy


sws is 100% redundant


Sheets("Sheet2").Cells(10, .Columnscount)
to which object is .ColumnsCount referring ?
Besides .columnscount doesn't exist as range property.

In

Sheets("Sheet2").Cells(20, .ColumnsCount).Left(xlToLeft).Offset(0, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
is 100% redundant.


Why not ?

Sheets("Sheet2").Cells(10,Columns.Count).Left(xlToLeft).Offset(0, 1).resize(2)=Sheets("Sheet1").Range("C10:C11").value

[arnelgp]

you may also try this:


Sub copyandpaste()
Dim sws As Worksheet
Dim dws As Worksheet
Dim EmptyColumn As Integer

Set sws = Sheets("Sheet1")
Set dws = Sheets("Sheet2")

'find the next empty column
EmptyColumn = LastColumn(dws) + 1

sws.Range("C10:C11").Copy
dws.Cells(6, EmptyColumn).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
sws.Range("H20:H40").Copy
dws.Cells(9, EmptyColumn).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'remove the dashed line
Application.CutCopyMode = False
dws.Cells(1, EmptyColumn).Select
End Sub

Public Function LastColumn(Optional ByRef sht = Nothing)
Dim LColumn As Long
On Error Resume Next
If sht Is Nothing Then sht = ActiveSheet
LColumn = sht.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
LastColumn = LColumn
End Function

[Aussiebear]

Nice effort arnelgp.