Sub Xlsx2DOCx()
Call Grouper
Call ToDocx
End Sub
Sub ToDocx()
Dim DocWord As Object
Dim objDoc As Object
Set DocWord = CreateObject("Word.Application")
DocWord.Visible = True
Set DocWord = DocWord.Documents.Add()
nbr1 = Range("A1").End(xlDown).Row
ActiveSheet.Range("A1:E" & nbr1).Copy
DocWord.Range.PasteSpecial Link:=False, DataType:=wdPasteText, Placement:= _
wdInLine, DisplayAsIcon:=False
Application.CutCopyMode = False
End Sub
Sub Grouper()
Dim nbsh As Integer
ActiveSheet.Name = "Source"
nbr = Range("A1").End(xlDown).Row
nbsh = Sheets.Count
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "XL2DC"
Sheets("Source").Range("B1:D" & nbr).Copy
Sheets("XL2DC").Cells(1, 1).PasteSpecial Paste:=xlPasteValues
Sheets("Source").Range("J1:J" & nbr).Copy
Sheets("XL2DC").Cells(1, 4).PasteSpecial Paste:=xlPasteValues
Sheets("Source").Range("M1:M" & nbr).Copy
Sheets("XL2DC").Cells(1, 5).PasteSpecial Paste:=xlPasteValues
Cells.Select
Cells.EntireColumn.AutoFit
End Sub