1つのシートで複数のセル範囲を選択し、選択したセルを印刷しようとすると、選択した領域ごとに1つのシートが表示されます。

次のマクロの例では、選択したすべての領域を1つのシートに印刷します。ただし、領域が大きすぎて1つのシートに収まらない場合を除きます。

Sub PrintSelectedCells()

' prints selected cells, use from a toolbar button or a menu

Dim aCount As Integer, cCount As Integer, rCount As Integer

Dim i As Integer, j As Long, aRange As String

Dim rHeight() As Single, cWidth() As Single

Dim AWB As Workbook, NWB As Workbook

If UCase(TypeName(ActiveSheet)) <> "WORKSHEET" Then Exit Sub

' useful only in worksheets

aCount = Selection.Areas.Count

If aCount = 0 Then Exit Sub ' no cells selected

cCount = Selection.Areas(1).Cells.Count

If aCount > 1 Then ' multiple areas selected

Application.ScreenUpdating = False

Application.StatusBar = "Printing " & aCount & " selected areas..."

Set AWB = ActiveWorkbook

rCount = ActiveSheet.Cells.SpecialCells(xlLastCell).Row

cCount = ActiveSheet.Cells.SpecialCells(xlLastCell).Column

ReDim rHeight(rCount)

ReDim cWidth(cCount)

For i = 1 To rCount

' find the row height of every row in the selection

rHeight(i) = Rows(i).RowHeight

Next i

For i = 1 To cCount

' find the column width of every column in the selection

cWidth(i) = Columns(i).ColumnWidth

Next i

Set NWB = Workbooks.Add ' create a new workbook

For i = 1 To rCount ' set row heights

Rows(i).RowHeight = rHeight(i)

Next i

For i = 1 To cCount ' set column widths

Columns(i).ColumnWidth = cWidth(i)

Next i

For i = 1 To aCount

AWB.Activate

aRange = Selection.Areas(i).Address

' the range address

Range(aRange).Copy ' copying the range

NWB.Activate

With Range(aRange) ' pastes values and formats

.PasteSpecial Paste:=xlValues, Operation:=xlNone, _

SkipBlanks:=False, Transpose:=False

.PasteSpecial Paste:=xlFormats, Operation:=xlNone, _

SkipBlanks:=False, Transpose:=False

End With

Application.CutCopyMode = False

Next i

NWB.PrintOut

NWB.Close False ' close the temporary workbook without saving

Application.StatusBar = False

AWB.Activate

Set AWB = Nothing

Set NWB = Nothing

Else

If cCount < 10 Then ' less than 10 cells selected

If MsgBox("Are you sure you want to print " & _

cCount & " selected cells ?", _

vbQuestion + vbYesNo, "Print celected cells") = vbNo Then Exit Sub

End If

Selection.PrintOut

End If

End Sub