Excel VBA copying specific columns

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