Hi Reader

Do you know why selection.* not work ? Need to add "application."
before selection ?


Sub CopySelectedRange()
'~~ By row
Dim a As Range
Dim ThisWB As Workbook
Dim ThisSheet As Worksheet
Dim NewWB As Workbook
Dim NewSheet As Worksheet
Dim ir As Long
Dim ic As Long
Dim TarRow As Long
On Error GoTo cxError

Application.ScreenUpdating = False
Set ThisWB = ActiveWorkbook
Set ThisSheet = ThisWB.ActiveSheet
Set NewWB = Workbooks.Add
Set NewSheet = NewWB.ActiveSheet

ThisSheet.Activate

TarRow = 1
If Application.Selection.Areas.Count = 0 Then
MsgBox "No Area selected"
Exit Sub
Else
MsgBox Application.Selection.Areas.Count
End If

For Each a In Application.Selection.Areas
'MsgBox ir & " " & ic
For ir = 1 To a.Rows.Count
For ic = 1 To a.Columns.Count

NewSheet.Cells(TarRow, ic).Interior.ColorIndex =
a.Cells(ir, ic).Interior.ColorIndex
With NewSheet.Cells(TarRow, ic)
.Value = a.Cells(ir, ic).Value
.NumberFormatLocal = a.Cells(ir, ic).NumberFormatLocal
.Font.ColorIndex = a.Cells(ir, ic).Font.ColorIndex
.Font.Bold = a.Cells(ir, ic).Font.Bold
End With

Next
TarRow = TarRow + 1
Next

Next a

With NewSheet
.Activate
.Cells.Select
.Cells.EntireColumn.AutoFit
.Range("A1").Select
End With
Application.ScreenUpdating = True
Exit Sub


cxError:
Application.ScreenUpdating = True
MsgBox Err.Number & " " & Err.Description

End Sub