The following will do what you asked, but be aware that it will shrink the worksheet to the space available. To limit the range copied you could change
xlSheet.UsedRange.Copy to copy the required range.
Change the sheet name and the bookmark name to match what you have. The bookmark is retained so you can run the macro again with a different workbook to replace the copied sheet.
Code:
Option Explicit
Sub CopyWorksheet()
'Graham Mayor - https://www.gmayor.com - Last updated - 26 Feb 2020
Dim xlApp As Object
Dim xlBook As Object
Dim xlSheet As Object
Dim bStarted As Boolean, bOpen As Boolean
Dim strWB As String
Const strSheet As String = "Sheet1" 'the name of the sheet to copy
Const strBM As String = "BookmarkName" ' the name of the bookmark
strWB = BrowseForFile("Select Workbook", True)
If strWB = "" Then
Beep
GoTo lbl_Exit
End If
On Error Resume Next
Set xlApp = GetObject(, "Excel.Application")
If Err Then
Set xlApp = CreateObject("Excel.Application")
bStarted = True
End If
On Error GoTo lbl_Exit
xlApp.Visible = True
For Each xlBook In xlApp.Workbooks
If xlBook.Name = strWB Then
bOpen = True
Exit For
End If
Next xlBook
If Not bOpen Then Set xlBook = xlApp.Workbooks.Open(FileName:=strWB)
Set xlSheet = xlBook.Sheets(strSheet)
xlSheet.UsedRange.Copy
If ActiveDocument.Bookmarks.Exists(strBM) = False Then
MsgBox "Bookmark " & strBM & " does not exist?"
Else
XLSheetToBM strBM
End If
xlApp.DisplayAlerts = False
xlApp.DisplayAlerts = True
If bStarted = True Then
xlBook.Close 0
xlApp.Quit
End If
lbl_Exit:
Set xlApp = Nothing
Set xlBook = Nothing
Set xlSheet = Nothing
Exit Sub
End Sub
Private Sub XLSheetToBM(strbmName As String)
'Graham Mayor - https://www.gmayor.com
Dim oRng As Range
With ActiveDocument
On Error GoTo lbl_Exit
Set oRng = .Bookmarks(strbmName).Range
oRng.Text = ""
oRng.PasteSpecial _
link:=False, _
DataType:=wdPasteBitmap, _
Placement:=wdInLine, _
DisplayAsIcon:=False
oRng.Start = oRng.Start - 1
oRng.Bookmarks.Add strbmName
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub
Private Function BrowseForFile(Optional strTitle As String, Optional bExcel As Boolean) As String
'Graham Mayor - https://www.gmayor.com
'strTitle is the title of the dialog box
'Set bExcel value to True to filter the dialog to show Excel files
'The default is to show Word files
Dim fDialog As FileDialog
On Error GoTo err_Handler
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.TITLE = strTitle
.AllowMultiSelect = False
.Filters.Clear
If bExcel Then
.Filters.Add "Excel workbooks", "*.xls,*.xlsx,*.xlsm"
Else
.Filters.Add "Word documents", "*.doc,*.docx,*.docm"
End If
.InitialView = msoFileDialogViewList
If .Show <> -1 Then GoTo err_Handler:
BrowseForFile = fDialog.SelectedItems.Item(1)
End With
lbl_Exit:
Exit Function
err_Handler:
BrowseForFile = vbNullString
Resume lbl_Exit
End Function