Excel VBA copying specific columns - vba

Question

I have the following VBA code for excel
Dim k As Integer, z As Integer
Dim sourceSht As Worksheet
Dim destSht As Worksheet
z = 0
Set sourceSht = Sheets("sheet1")
Set destSht = Sheets("sheet2")
DoEvents
For k = 1 To 5000
If k < 3 Or (k - 1) Mod 3 <> 0 Then
z = z + 1
sourceSht.Columns(k).Copy destSht.Columns(z)
End If
Next
This code was working perfectly for rows (changed this part"sourceSht.Columns(k).Copy destSht.Columns(z)").
but I can not make it work for columns. I want excel to copy the first 2 columns then skip the third one, then copy 2 again, skip one and etc... can somebody help me and explain what am I doing wrong?

Answer 1

I'm going to ignore the use of mod and do a Step 3 with the loop:
Dim i as Long, j as Long
For i = 1 to 5000 Step 3
With sourceSht
If j = 0 Then
j = 1
Else
j = j + 2 'Copying 2 columns over, so adding 2 each time
End If
.Range(.Columns(i),.Columns(i+1)).Copy destSht.Range( destSht.Columns(j), destSht.Column(j+1))
End With
Next i
Something like that should do it for you

Answer 2

Alternate:
Sub tgr()
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Dim rCopy As Range
Dim rLast As Range
Dim LastCol As Long
Dim i As Long
Set wsSource = ActiveWorkbook.Sheets("Sheet1")
Set wsDest = ActiveWorkbook.Sheets("Sheet2")
On Error Resume Next
Set rLast = wsSource.Cells.Find("*", wsSource.Range("A1"), xlFormulas, , xlByColumns, xlPrevious)
On Error GoTo 0
If rLast Is Nothing Then Exit Sub 'No data
LastCol = rLast.Column
Set rCopy = wsSource.Range("A:B")
For i = 4 To LastCol Step 3
Set rCopy = Union(rCopy, wsSource.Columns(i).Resize(, 2))
Next i
rCopy.Copy wsDest.Range("A1")
End Sub

Answer 3

Try this (use count for the number of time you need to copy columns, t for the first columns you need to copy):
Sub copy_columns()
t = 1
Count = 1
Do Until Count = 10
Range(Columns(t), Columns(t + 1)).Copy
Cells(1, t + 3).Select
Selection.PasteSpecial Paste:=xlPasteValues
t = t + 3
Count = Count + 1
Loop
End Sub