2、5、8、11…列目を残して、後の列を全て削除したい

これでどうでしょうか？

Public Sub deleteColumns()

    Const TARGET_SHEET_NAME As String = "Sheet1"
    Const BEGIN_COL         As Long = 2
    Const BEGIN_ROW         As Long = 2
    Const END_ROW           As Long = 100
    Const COL_CYCLE         As Long = 3

    Dim rgDatas     As Range
    Dim lCurrentCol As Long
    Dim lDataCounts As Long

    lCurrentCol = BEGIN_COL

    With ThisWorkbook.Worksheets(TARGET_SHEET_NAME)
        Do
            '基準列の右側（次の基準列の前まで）
            Set rgDatas = .Range(.Cells(BEGIN_ROW, lCurrentCol + 1), .Cells(END_ROW, lCurrentCol + COL_CYCLE - 1))

            'データがあるセル数取得
            lDataCounts = WorksheetFunction.CountA(rgDatas)

            If lDataCounts > 0 Then
                'データがあれば列削除
                rgDatas.EntireColumn.Delete

                lCurrentCol = lCurrentCol + 1
            End If
        Loop Until (lDataCounts = 0)
    End With

    Debug.Print "Done."

End Sub