By using manual selection(s) , I copy range(s) from workbook to another workbook.
But, how to select the headings of this selection(s) to be union with the selection itself , to fulfill copy and paste in one shot.
Headings are found on first row.
e.g, contiguous selection if I selected Range “B3:D5” , subsequently I need to select ”B1:D1” and union with Range “B3:D5”.
e.g, non-contiguous selection if I selected Range “B3:D5,F3:F5” , subsequently I need to select ”B1:D1,F1” and union with Range “B3:D5,F3:F5”
Copying of contiguous selection and non- contiguous selections (in the same rows) works without problem.
In advance, grateful for useful answer and comments.

Dim wb As Workbook: Set wb = ThisWorkbook    'Source Workbook
Dim srg As Range: Set srg = wb.ActiveSheet.Range(Selection.Address)

Dim wb1 As Workbook: Set wb1 = Workbooks.Add  'Destination Workbook
Dim drg As Range: Set drg = wb1.Sheets(1).Range("A1")

srg.Copy
drg.PasteSpecial Paste:=xlPasteColumnWidths
srg.Copy drg      

Dim r As Range
  For Each r In drg.Rows
  r.WrapText = True
    If r.RowHeight < 40 Then r.RowHeight = 40  
       Next r

CodePudding user response：

If you want the Selected range Unioned with row one, try this

Dim srg As Range
Set srg = Selection ' no need to go via Selection.Address
Set srg = Application.Union(srg, srg.EntireColumn.Rows(1))

Or just

Set srg = Application.Union(Selection, Selection.EntireColumn.Rows(1))

CodePudding user response：

Copy Header With Selection

Option Explicit

Sub ExportSelection()
    
    If Not TypeOf Selection Is Range Then Exit Sub
    
    Dim dfCell As Range
    With Selection
        With Union(.EntireColumn.Rows(1), .Cells)
            .Rows(1).Copy
            Set dfCell = Workbooks.Add(xlWBATWorksheet) _
                .Worksheets(1).Range("A1")
            dfCell.PasteSpecial xlPasteColumnWidths
            .Copy dfCell
        End With
    End With
    
    With dfCell.CurrentRegion ' headers and data
        Dim rrg As Range
        For Each rrg In .Rows
            rrg.WrapText = True
            If rrg.RowHeight < 40 Then rrg.RowHeight = 40
        Next rrg

        With .Rows(1) ' headers
        
        End With
        
        With .Resize(.Rows.Count - 1).Offset(1) ' data
        
        End With
    
        With .Worksheet ' worksheet
            Debug.Print .Name
            With .Parent ' workbook
                Debug.Print .Name
                .Saved = True ' for easy closing when developing
            End With
        End With
    
    End With

End Sub