Adding data from Excel to Word throwing a run time error

G

GirishDhruva

Active Member
Joined
Mar 26, 2019
Messages
308
Hi Everyone,
Here i have tried with some data that should be added from Excel to Word, later convert from Excel to Word and Good thing is that below code runs, but after executing with some sheets it throws me a run time error and code exits
Can anyone help me to solve this out

Below is my workbook which i am working
https://app.box.com/s/slwwvm6zrdt7po8ecilfs7zi0pbeuta1

Below is my code
Code: 
Sub error()
    Dim appWD As Word.Application
    Dim lastrow As Long
    Dim name As String
    Dim rng As Range
    Set appWD = CreateObject("Word.Application")
    appWD.Visible = True
    Application.ScreenUpdating = False
    Sheets("Revision").Select
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    filesave = Range("N2").Value
    For i = 2 To lastrow
        Sheets("Revision").Select
        emp_id = Range("A" & i).Value
        name = Range("B" & i).Value
        Range("B" & i).Copy Destination:=Sheets("Template").Range("A1")
        Range("D" & i).Copy Destination:=Sheets("Template").Range("A2")
        Range("E" & i).Copy Destination:=Sheets("Template").Range("A3")
        Range("B" & i).Copy Destination:=Sheets("Template").Range("F16")
        Range("D" & i).Copy Destination:=Sheets("Template").Range("F17")
        Range("B" & i).Copy Destination:=Sheets("Template").Range("B4")
        Range("M" & i).Copy Destination:=Sheets("Template").Range("D4")
        Range("F" & i & ":L" & i).Copy
        Worksheets("Template").Select
        Range("C8").PasteSpecial Transpose:=True
        Range("B11:D11").Select
        With Selection.Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent3
            .TintAndShade = 0.399975585192419
            .PatternTintAndShade = 0
        End With
        Range("A1:C4").Copy
        appWD.Documents.Add
        With appWD
            .Selection.Font.Bold = True
            .Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
            .Selection.TypeText Text:="PROMOTION & SALARY REVISION LETTER"
            .Selection.TypeParagraph
            .Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
            .Selection.InsertDateTime
            .Selection.TypeParagraph
            .Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
            .Selection.PasteSpecial DataType:=wdPasteText
            .Selection.Font.Bold = False
            .Selection.TypeParagraph
            .Selection.TypeText Text:="This is to keep you informed that your designation & salary has been revised with effect from "
            .Selection.TypeParagraph
            '.Selection.Font.Bold = True
            '.Selection.TypeText Text:="30th May 2019"
            '.Selection.Font.Bold = False
        End With
        Worksheets("Template").Select
        Range("D4").Copy
        With appWD
            .Selection.Font.Bold = True
            .Selection.Paste
            .Selection.Font.Bold = False
        End With
        Worksheets("Template").Select
        Range("D8").Formula = "=RC[-1]*12"
        Range("D9").Formula = "=RC[-1]*12"
        Range("D10").Formula = "=RC[-1]*12"
        Range("D11").Formula = "=RC[-1]*12"
        Range("D12").Formula = "=RC[-1]*12"
        Range("D13").Formula = "=RC[-1]*12"
        Range("D14").Formula = "=RC[-1]*12"
        Range("B14:D14").Select
        With Selection.Interior
            .PatternColorIndex = xlAutomatic
            .ThemeColor = xlThemeColorAccent4
            .TintAndShade = 0.399975585192419
            .PatternTintAndShade = 0
        End With
        Set rng = Range("C7:C14")
         With rng.Borders
            .LineStyle = xlContinuous
            .Color = vbBlack
            .Weight = xlThin
        End With
        Range("B6:D14").Copy
        With appWD
            .Selection.PasteExcelTable LinkedToExcel:=False, _
                WordFormatting:=False, RTF:=False
            .Selection.TypeParagraph
            .Selection.TypeText Text:="The remuneration stated above is subject to the terms and conditions of your contract of employment of which this is a part"
            .Selection.TypeParagraph
            .Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
            .Selection.Font.Bold = True
            .Selection.TypeText Text:="ACKNOWLEDGED AND AGREED"
            .Selection.TypeParagraph
            .Selection.ParagraphFormat.Alignment = wdAlignParagraphLeft
            .Selection.TypeText Text:="Yours faithfully"
            .Selection.TypeParagraph
            .Selection.TypeText Text:="XYZ Private Limited.,"
            .Selection.TypeParagraph
            .Selection.TypeParagraph
            .Selection.TypeText Text:="ABC"
            .Selection.TypeParagraph
            .Selection.TypeText Text:="CEO                                                                        ACCEPTANCE"
            '.Selection.TypeParagraph
            '.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
            '.Selection.TypeText Text:="ACCEPTANCE"
        End With
        Worksheets("Template").Select
        Range("E16:F17").Copy
        With appWD
            .Selection.TypeParagraph
            .Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
            .Selection.PasteSpecial DataType:=wdPasteText
            .ActiveDocument.SaveAs Filename:=filesave & "\" & emp_id & "_" & name
            .ActiveDocument.Close
        End With
        Application.CutCopyMode = False
        Sheets("Revision").Select
        'Application.Wait (Now + TimeValue("0:00:02"))
    Next i
    'Application.ScreenUpdating = True
    appWD.Quit
End Sub

Thanks in advance
Dhruv
 

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Sort by date Sort by votes
What's the error and where/when does it occur?
 
Upvote 0
I have updated my Code
Code: 
Sub Revision()
    Dim appWD As Word.Application
    Dim lastrow As Long
    Dim name As String
    Dim rng As Range
    Dim ws, ws1 As Worksheet
    Set appWD = CreateObject("Word.Application")
    appWD.Visible = True
    Application.ScreenUpdating = False
    Sheets("Revision").Select
    filesave = Range("N2").Value
    Set ws = Sheets("Revision")
    Set ws1 = Sheets("Template")
    
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastrow
        With ws
            emp_id = Range("A" & i).Value
            name = Range("B" & i).Value
            .Range("B" & i).Copy Destination:=Sheets("Template").Range("A1")
            .Range("D" & i).Copy Destination:=Sheets("Template").Range("A2")
            .Range("E" & i).Copy Destination:=Sheets("Template").Range("A3")
            .Range("B" & i).Copy Destination:=Sheets("Template").Range("F16")
            .Range("D" & i).Copy Destination:=Sheets("Template").Range("F17")
            .Range("B" & i).Copy Destination:=Sheets("Template").Range("B4")
            .Range("M" & i).Copy Destination:=Sheets("Template").Range("D4")
            .Range("F" & i & ":L" & i).Copy
            With ws1
                .Range("C8").PasteSpecial Transpose:=True
                .Application.CutCopyMode = False
            End With
        End With
        With ws1.Range("A1:C4")
            .Copy
            appWD.Documents.Add
            With appWD.Selection
                .Font.Bold = True
                .ParagraphFormat.Alignment = wdAlignParagraphCenter
                .TypeText Text:="PROMOTION & SALARY REVISION LETTER"
                .TypeParagraph
                .ParagraphFormat.Alignment = wdAlignParagraphRight
                .InsertDateTime
                .TypeParagraph
                .ParagraphFormat.Alignment = wdAlignParagraphLeft
                .PasteSpecial DataType:=wdPasteText
                .Font.Bold = False
                .TypeParagraph
                .TypeText Text:="This is to keep you informed that your designation & salary has been revised with effect from "
                .TypeParagraph
            End With
        End With
        
        With ws1.Range("D4")
            .Application.CutCopyMode = False
            .Copy
            With appWD.Selection
                '.Font.Bold = True
                .Paste
                '.Font.Bold = False
            End With
        End With
        
        With ws1
            .Range("D8").Formula = "=RC[-1]*12"
            .Range("D9").Formula = "=RC[-1]*12"
            .Range("D10").Formula = "=RC[-1]*12"
            .Range("D11").Formula = "=RC[-1]*12"
            .Range("D12").Formula = "=RC[-1]*12"
            .Range("D13").Formula = "=RC[-1]*12"
            .Range("D14").Formula = "=RC[-1]*12"
            Set rng = Range("C7:C14")
            With rng.Borders
                .LineStyle = xlContinuous
                .Color = vbBlack
                .Weight = xlThin
            End With
            Application.CutCopyMode = False
        End With
        With ws1.Range("B6:D14")
            .Application.CutCopyMode = False
            .Copy
            With appWD.Selection
                .PasteExcelTable LinkedToExcel:=False, _
                    WordFormatting:=False, RTF:=False
                .TypeParagraph
                .TypeText Text:="The remuneration stated above is subject to the terms and conditions of your contract of employment of which this is a part"
                .TypeParagraph
                .ParagraphFormat.Alignment = wdAlignParagraphCenter
                .Font.Bold = True
                .TypeText Text:="ACKNOWLEDGED AND AGREED"
                .TypeParagraph
                .ParagraphFormat.Alignment = wdAlignParagraphLeft
                .TypeText Text:="Yours faithfully"
                .TypeParagraph
                .TypeText Text:="XYZ Private Limited.,"
                .TypeParagraph
                .TypeParagraph
                .TypeText Text:="ABC"
                .TypeParagraph
                .TypeText Text:="CEO                                                                        ACCEPTANCE"
            End With
        End With
        
        With ws1.Range("E16:F17")
            .Application.CutCopyMode = False
            .Copy
            With appWD
                .Selection.TypeParagraph
                .Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
                .Selection.PasteSpecial DataType:=wdPasteText
                .ActiveDocument.SaveAs Filename:=filesave & "\" & emp_id & "_" & name & "_Increment_Letter" & "_1920"
                .ActiveDocument.Close
            End With
            Application.CutCopyMode = False
        End With
        Sheets("Revision").Select
    Next i
    appWD.Quit
End Sub


Think i have some 40 records and if i run the above code now i am getting these Errors
>On the document '6' , my code is delayed more
>After 10th document its throwing me the run time error 4605. In this code
Code: 
With appWD.Selection
      '.Font.Bold = True
       .Paste
      '.Font.Bold = False
End With

Suggest me with some solution Please

Thanks
Dhruv
 
Last edited:
Upvote 0
Dhruv

When you get the error(s) and click Debug which line(s) of code are highlighed?
 
Upvote 0
GirishDhruva said:
I have updated my Code
Rich (BB code): 
Sub Revision()
    Dim appWD As Word.Application
    Dim lastrow As Long
    Dim name As String
    Dim rng As Range
    Dim ws, ws1 As Worksheet
    Set appWD = CreateObject("Word.Application")
    appWD.Visible = True
    Application.ScreenUpdating = False
    Sheets("Revision").Select
    filesave = Range("N2").Value
    Set ws = Sheets("Revision")
    Set ws1 = Sheets("Template")
    
    lastrow = Cells(Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastrow
        With ws
            emp_id = Range("A" & i).Value
            name = Range("B" & i).Value
            .Range("B" & i).Copy Destination:=Sheets("Template").Range("A1")
            .Range("D" & i).Copy Destination:=Sheets("Template").Range("A2")
            .Range("E" & i).Copy Destination:=Sheets("Template").Range("A3")
            .Range("B" & i).Copy Destination:=Sheets("Template").Range("F16")
            .Range("D" & i).Copy Destination:=Sheets("Template").Range("F17")
            .Range("B" & i).Copy Destination:=Sheets("Template").Range("B4")
            .Range("M" & i).Copy Destination:=Sheets("Template").Range("D4")
            .Range("F" & i & ":L" & i).Copy
            With ws1
                .Range("C8").PasteSpecial Transpose:=True
                .Application.CutCopyMode = False
            End With
        End With
        With ws1.Range("A1:C4")
            .Copy
            appWD.Documents.Add
            With appWD.Selection
                .Font.Bold = True
                .ParagraphFormat.Alignment = wdAlignParagraphCenter
                .TypeText Text:="PROMOTION & SALARY REVISION LETTER"
                .TypeParagraph
                .ParagraphFormat.Alignment = wdAlignParagraphRight
                .InsertDateTime
                .TypeParagraph
                .ParagraphFormat.Alignment = wdAlignParagraphLeft
                .PasteSpecial DataType:=wdPasteText
                .Font.Bold = False
                .TypeParagraph
                .TypeText Text:="This is to keep you informed that your designation & salary has been revised with effect from "
                .TypeParagraph
            End With
        End With
        
        With ws1.Range("D4")
            .Application.CutCopyMode = False
            .Copy
            With appWD.Selection
                '.Font.Bold = True
                .Paste
                '.Font.Bold = False
            End With
        End With
        
        With ws1
            .Range("D8").Formula = "=RC[-1]*12"
            .Range("D9").Formula = "=RC[-1]*12"
            .Range("D10").Formula = "=RC[-1]*12"
            .Range("D11").Formula = "=RC[-1]*12"
            .Range("D12").Formula = "=RC[-1]*12"
            .Range("D13").Formula = "=RC[-1]*12"
            .Range("D14").Formula = "=RC[-1]*12"
            Set rng = Range("C7:C14")
            With rng.Borders
                .LineStyle = xlContinuous
                .Color = vbBlack
                .Weight = xlThin
            End With
            Application.CutCopyMode = False
        End With
        With ws1.Range("B6:D14")
            .Application.CutCopyMode = False
            .Copy
            With appWD.Selection
                .PasteExcelTable LinkedToExcel:=False, _
                    WordFormatting:=False, RTF:=False
                .TypeParagraph
                .TypeText Text:="The remuneration stated above is subject to the terms and conditions of your contract of employment of which this is a part"
                .TypeParagraph
                .ParagraphFormat.Alignment = wdAlignParagraphCenter
                .Font.Bold = True
                .TypeText Text:="ACKNOWLEDGED AND AGREED"
                .TypeParagraph
                .ParagraphFormat.Alignment = wdAlignParagraphLeft
                .TypeText Text:="Yours faithfully"
                .TypeParagraph
                .TypeText Text:="XYZ Private Limited.,"
                .TypeParagraph
                .TypeParagraph
                .TypeText Text:="ABC"
                .TypeParagraph
                .TypeText Text:="CEO                                                                        ACCEPTANCE"
            End With
        End With
        
        With ws1.Range("E16:F17")
            .Application.CutCopyMode = False
            .Copy
            With appWD
                .Selection.TypeParagraph
                .Selection.ParagraphFormat.Alignment = wdAlignParagraphRight
                .Selection.PasteSpecial DataType:=wdPasteText
                .ActiveDocument.SaveAs Filename:=filesave & "\" & emp_id & "_" & name & "_Increment_Letter" & "_1920"
                .ActiveDocument.Close
            End With
            Application.CutCopyMode = False
        End With
        Sheets("Revision").Select
    Next i
    appWD.Quit
End Sub


Think i have some 40 records and if i run the above code now i am getting these Errors
>On the document '6' , my code is delayed more
>After 10th document its throwing me the run time error 4605. In this code
Rich (BB code): 
With appWD.Selection
      '.Font.Bold = True
       .Paste
      '.Font.Bold = False
End With

Suggest me with some solution Please

Thanks
Dhruv
Click to expand...
As I debugged and checked in the above code highlighted line it's throwing me an Error
 
Upvote 0
Cross posted https://www.excelforum.com/excel-pr...rd-throwing-a-run-time-error.html#post5130152

While we do not prohibit Cross-Posting on this site, we do ask that you please mention you are doing so and provide links in each of the threads pointing to the other thread (see rule 13 here along with the explanation: Forum Rules).
This way, other members can see what has already been done in regards to a question, and do not waste time working on a question that may already be answered.
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Copying whole word document, into excel + formatting columns and cells
Replies
1
Views
265
Macropod
Macropod
P
  • Question Question
Copy an excel table and paste it into word
Replies
2
Views
961
Paskie_EU
P
B
  • Question Question
Runtime error trying to create a bulleted list in Word using Excel VBA
Replies
1
Views
404
rlv01
R
O
  • Question Question
Copy from Excel into a new word document
Replies
3
Views
923
Macropod
Macropod
J
  • Solved
Create Word document and center title
Replies
5
Views
532
Tetra201
Tetra201

Forum statistics

Threads
1,223,909
Messages
6,175,314
Members
452,634
Latest member
cpostell

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top