#1
|
|||
|
|||
VBA - copy sheet from excel
Hi, I have one word template with bookmarks included. I have to have a macro in word which open a browse window to select an excel file, copy a specific sheet (in every excel file the sheets are with same names) from it to specific bookmark in the word doc. The table in the doc file have to be with the format from the excel file or have to be auto fitted in the doc. Thank you in advance for the help! N |
#2
|
||||
|
||||
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
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#3
|
||||
|
||||
Cross-posted at: VBA - copy sheet from Excel to Word
For cross-posting etiquette, please read: Excelguru Help Site - A message to forum cross posters
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
#4
|
|||
|
|||
Hi and thank you for the assistance. Is there a way in the same macro to wright a code for multiple bookmarks and sheets?
|
#5
|
||||
|
||||
It is basically a matter of defining the additional bookmark names in the main macro and repeating the marked section for each of them
Code:
Sub CopyWorksheet() 'Graham Mayor - https://www.gmayor.com - Last updated - 04 Mar 2020 Dim xlApp As Object Dim xlBook As Object Dim xlSheet As Object Dim bStarted As Boolean, bOpen As Boolean Dim strWB As String Dim strBM As String Dim strSheet As String 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) 'Repeat this section to define each bookmark and the sheet/range you wish to copy to it '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ strBM = "BookmarkName1" ' the name of the bookmark strSheet = "Sheet1" 'the name of the sheet to copy 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
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
#6
|
|||
|
|||
Hi again,
the debugger has told be taht strWB = BrowseForFile("Select Workbook", True) is not defined, but i dont know why.... Edit: thank you. I'm done! |
#7
|
||||
|
||||
You still need the rest of the code including the BrowseForFile Function from the original reply, which are unchanged. You get the error if that code is missing.
__________________
Graham Mayor - MS MVP (Word) (2002-2019) Visit my web site for more programming tips and ready made processes www.gmayor.com |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
How to copy excel sheet withe HEADER and Paste into new sheet? | cloudforgiven | Excel Programming | 6 | 01-05-2017 07:30 PM |
copy checkbox string and paste it in excel sheet | MOHAMMEDSALMAN | Excel Programming | 7 | 10-29-2015 03:50 AM |
How to copy all data from a website to excel sheet? Plz plz plz plz plz help...urgent | Sam123 | Excel | 0 | 07-19-2014 02:12 AM |
Find Results in excel copy the rows to another sheet | khalidfazeli | Excel | 2 | 02-06-2013 09:38 AM |
How to Copy data from Outlook mail and Paste it in a Excel sheet? | padhu1989 | Outlook | 0 | 09-11-2012 04:07 AM |