excel-vba – Print alternate columns vba excel

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 in the col range. "c" to col. "S".

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

Thanks

Julius Faria

Answer:

Edit:

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

Note: This will only work if all columns have the same number 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

  • Defines the Number of Lines to be used

     Linha = 15

Or it could be the last line filled in column C:

    Linha = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
  • Creates the temporary spreadsheet and defines the spreadsheet in which the data to be used is stored:

     Set temp = Sheets.Add temp.Name = "Temporário" Set ws = Worksheets("Planilha1")
  • Set 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 into 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
  • Enter the Array values ​​in the 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 Preview window with the used range

     temp.Range(temp.Cells(1, 1), temp.Cells(lngLstRow, lngLstCol)).PrintPreview
  • Delete the Temporary worksheet

     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 keeping 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 to the new temporary worksheet. The other parts of the code have already been explained above.

Original Answer

You can define a non-continuous interval like this:

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

Wherein , each range can be separated by a comma ,

So the code would look like:

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. Because errors can 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

Scroll to Top