Print alternate vba excel columns

Question

with the code below:

    Range("C1:S" & Linha).Select
    ActiveSheet.PageSetup.PrintArea = "$C$1:$S$" & Linha
    Application.ScreenUpdating = True
    Range("C2").Select

I can print all columns of the range col. "c" until col. "S".

Is there any way to print only the col. "c", "D", "N", "O", "S" ?

Obrg.

Júlio Faria

Answer 1

Edit:

It is not possible to print a non-stop range directly on the same sheet. Then a temporary spreadsheet is created to store the data in order to print them.

Note: This will work only if all columns have the same amount of rows

Code:

Sub ImprimirNaoContinuo()

    Dim rngPrint As Range
    Dim Linha As Long, i As Long
    Dim temp As Worksheet, ws As Worksheet
    Dim Arr() As Variant
    Linha = 15
    Set temp = Sheets.Add
    temp.Name = "Temporário"
    Set ws = Worksheets("Planilha1")
    Set rngPrint = Union(ws.Range("C1:$D" & Linha), ws.Range("$N$1:$O" & Linha), ws.Range("$S$1:$S" & Linha))

    'Função para preencher array com intervalo não contínuo
    'https://stackoverflow.com/a/18994211/7690982
    nr = rngPrint.Areas(1).Rows.Count
    ReDim Arr(1 To nr, 1 To rngPrint.Cells.Count / nr)
    cnum = 0
    For Each ar In rngPrint.Areas
        For Each col In ar.Columns
            cnum = cnum + 1
            rnum = 1
            For Each c In col.Cells
                Arr(rnum, cnum) = c.Value
                rnum = rnum + 1                  'EDIT: added missing line...
            Next c
        Next col
    Next ar


    For k = 1 To cnum
        For i = LBound(Arr) To UBound(Arr)
            temp.Cells(i, k) = Arr(i, k)
        Next i
    Next k

    lngLstRow = ws.UsedRange.Rows.Count
    lngLstCol = ws.UsedRange.Columns.Count

    temp.Range(temp.Cells(1, 1), temp.Cells(lngLstRow, lngLstCol)).PrintPreview
    Application.ScreenUpdating = True
    Application.DisplayAlerts = False
    temp.Delete
    Application.DisplayAlerts = True
End Sub

Explanation

• Sets the Number of Lines to be used

  Linha = 15
  

Or it can be the last row filled in in column C:

    Linha = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row

• Creates the temporary worksheet and defines the worksheet in which the data to be used is stored:

  Set temp = Sheets.Add
  temp.Name = "Temporário"
  Set ws = Worksheets("Planilha1")
  

• Sets the Range with the data that will be saved

  Set rngPrint = Union(ws.Range("C1:$D" & Linha), ws.Range("$N$1:$O" & Linha), ws.Range("$S$1:$S" & Linha))
  

• Function to sort the non-continuous range in an array

  nr = rngPrint.Areas(1).Rows.Count
  ReDim Arr(1 To nr, 1 To rngPrint.Cells.Count / nr)
  cnum = 0
  For Each ar In rngPrint.Areas
      For Each col In ar.Columns
          cnum = cnum + 1
          rnum = 1
          For Each c In col.Cells
              Arr(rnum, cnum) = c.Value
              rnum = rnum + 1                  'EDIT: added missing line...
          Next c
      Next col
  Next ar
  

• Insert Array values into temporary worksheet

  For k = 1 To cnum
      For i = LBound(Arr) To UBound(Arr)
          temp.Cells(i, k) = Arr(i, k)
      Next i
  Next k
  

• Open the Print View window with the range used

  temp.Range(temp.Cells(1, 1), temp.Cells(lngLstRow, lngLstCol)).PrintPreview
  

• Delete the Temporary spreadsheet

  Application.DisplayAlerts = False
  temp.Delete
  Application.DisplayAlerts = True
  

Edit2:

To keep the formatting, each column used will be copied and then pasted into the temporary sheet, thus maintaining the formatting

Code

Sub ImprimirNaoContinuo2()

    Dim rngPrint As Range
    Dim Linha As Long, i As Long
    Dim temp As Worksheet, ws As Worksheet
    Dim Arr() As Variant

    Set temp = Sheets.Add
    temp.Name = "Temporário"
    Set ws = Worksheets("Planilha1")
    Linha = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    Set rngPrint = Union(ws.Range("C1:$D" & Linha), ws.Range("$N$1:$O" & Linha), ws.Range("$S$1:$S" & Linha))

    For Each coluna In rngPrint.Columns
        i = i + 1
        coluna.Copy temp.Cells(1, i)
    Next coluna

    lngLstRow = temp.UsedRange.Rows.Count
    lngLstCol = temp.UsedRange.Columns.Count

    temp.Range(temp.Cells(1, 1), temp.Cells(lngLstRow, lngLstCol)).PrintPreview
    Application.ScreenUpdating = True
    Application.DisplayAlerts = False
    temp.Delete
    Application.DisplayAlerts = True
End Sub

Explanation

    For Each coluna In rngPrint.Columns
        i = i + 1
        coluna.Copy temp.Cells(1, i)
    Next coluna

Each column in the non-continuous range is copied and pasted in order on the new temporary sheet. The other parts of the code have been explained earlier.

Original Response

You can set a non-continuous interval this way:

"$C$1:$D" & Linha & ", $N$1:$O" & Linha & ", $S$1:$S" & Linha

Where, each interval may be separated by a viper ,

So the code would be:

ActiveSheet.PageSetup.PrintArea = "$C$1:$D" & Linha & ", $N$1:$O" & Linha & ", $S$1:$S" & Linha
Application.ScreenUpdating = True
Range("C2").Select

Note: Try to avoid using .Select, ActiveCell, ActiveSheet, etc. As errors may occur. In SOEN there is a topic with some examples of how to avoid them in this link: How to avoid using Select in Excel VBA