Word pastes all rows in between from Excel selection instead of selection alone-CodePudding

I want to select some rows inside an Excel-Spreadsheet and then paste these rows as a Word-Table into a Word document using Selection.PasteExcelTable. Let's say the Macro is triggered by a button in Word:

Private Sub CommandButton1_Click()

Dim xlApp As Object
Dim xlSheet As Object
Dim table As Object

Const strWorkbookName As String = "PATH"

Set xlApp = CreateObject("Excel.Application")
Set xlSheet = xlApp.Workbooks.Open(FileName:=strWorkbookName).Sheets("Sheet1")

' returns a range of rows
select_rows_with_given_string("TEST", xlSheet).Copy
Selection.PasteExcelTable False, False, False

End Sub

And in my case select_rows_with_given_string returns the rows 1, 2, 5 and 6. When I trigger the button inside Word, rows 1,2,3,4,5 and 6 are pasted instead of 1,2,5,6. When I use select_rows_with_given_string inside excel and then paste it inside a spreadsheet everything works fine. Only 1,2,5,6 get pasted. How do I fix this in Word.

PS: If I select some not adjacent rows manually in Excel and paste them (ctrl v) into Word, the same thing happens. All rows in between get pasted too.

The following is the selection function:

Function select_rows_with_given_string(searchString As String, xlSheet As Object) As Object
 
 Dim myUnion As Object
 Dim Row As Integer
 
 endCol = "N"
 endRow = 46
 startRow = 3
 
 xlSheet.Activate
 Set myUnion = Excel.Range("A1:" & endCol & startRow - 1)
 
 For Row = startRow To endRow
    If Excel.Range("A" & Row).Value = searchString Then
        If Not myUnion Is Nothing Then
            Set myUnion = Excel.Union(myUnion, Excel.Range("A" & Row & ":" & endCol & Row))
        Else
            Set myUnion = Excel.Range("A" & Row & ":" & endCol & Row)
        End If
    End If
 Next Row
 
 Set select_rows_with_given_string = myUnion
 
 End Function

CodePudding user response：

Please, try the next adapted function. It hides the unnecessary rows and return the visible cells to be copied. And the hidden range to make all rows visible, too:

Function select_rows_with_given_string(searchString As String, xlSheet As Object, xlApp As Object) As Variant
 Dim rngH As Object, allRng As Object, endCol As String
 Dim Row As Integer, endRow As Long, startRow As Long
 
 endCol = "N": endRow = 46: startRow = 3
 Set allRng = xlSheet.Range("A1:" & endCol & endRow - 1) 'all the range to be returned
 
 For Row = startRow To endRow
    If xlSheet.Range("A" & Row).Value <> searchString Then '<>!!!
        If rngH Is Nothing Then
            Set rngH = xlSheet.Range("A" & Row)
        Else
            Set rngH = xlApp.Union(rngH, xlSheet.Range("A" & Row))
        End If
    End If
 Next Row
 rngH.EntireRow.Hidden = True 'hide all unnecessary rows...
 select_rows_with_given_string = Array(allRng.SpecialCells(12), rngH)
End Function

It needs some error handling for the case of any row keeping the searchString, when SpecialCells(xlCellTypeVisible) will return an error.

Your existing code should be adapted in the next way:

Private Sub CommandButton1_Click_()
 Dim xlApp As Object, xlSheet As Object, table As Object, arr

 Const strWorkbookName As String = "PATH"

 Set xlApp = CreateObject("Excel.Application")
 Set xlSheet = xlApp.Workbooks.Open(FileName:=strWorkbookName).Sheets("Sheet1")

 ' returns a range of ranges:
 arr = select_rows_with_given_string("TEST", xlSheet, xlApp)
 arr(0).Copy
 Selection.PasteExcelTable False, False, False
 arr(1).EntireRow.Hidden = False 'unhide the previously hidden rows...
End Sub

Please, test it and send some feedback.

CodePudding user response：

I found a really hacky way to do it. Basically I copy the rows, make a new sheet, then paste these rows there, then copy them again from the new sheet and then delete the sheet. There has to be a better way right?

Private Sub CommandButton1_Click()

Dim xlApp As Object
Dim xlSheet As Object
Dim table As Object

Const strWorkbookName As String = "PATH"

Set xlApp = CreateObject("Excel.Application")
Set xlSheet = xlApp.Workbooks.Open(FileName:=strWorkbookName).Sheets("Sheet1")

' returns a range of rows
select_rows_with_given_string("TEST", xlSheet).Copy

' sketchy fix
Excel.Sheets.Add After:=Excel.ActiveSheet
Excel.ActiveSheet.Paste
Excel.Selection.Copy
Excel.ActiveSheet.Delete

Selection.PasteExcelTable False, False, False