This code copies a specific range and a chart from an Excel sheet to Word. This code works fine but it is very slow. I have used delays(Wait) to work properly while dealing with clipboard copy-paste. If I don't use delays as error occurs.This program copies 140 Excel-ranges and 140 charts, so it takes a lot of time. Any suggestions to make the program execute faster?Sub ExcelToWord()    Dim fileName, Pathname As String    Dim WB As Workbook    Dim mychart As ChartObject    Pathname = c:\Charts\    vArr = Array(A, B, C, D, E, F, G, H, I, J)    For Each vFile In vArr        fileName = Dir(Pathname & vFile & \ & *.xlsx)        Dim WdObj As Object        Set WdObj = CreateObject(Word.Application)        WdObj.Documents.Add        'Loop for all files begins        Do While fileName <>             Set WB = Workbooks.Open(Pathname & vFile & \ & fileName)            ActiveSheet.Columns(C:C).Select            Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove            Dim rLastCell As Range            Dim ColLtr As String            Set rLastCell = ActiveSheet.Cells.Find(What:=*, After:=ActiveSheet.Cells(1, 1), LookIn:=xlFormulas, Lookat:= _            xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)            ColLtr = Replace(Cells(1, rLastCell.Column).Address(True, False), $1, )            ActiveSheet.Columns(ColLtr).Copy            ActiveSheet.Columns(C).Select            ActiveSheet.Paste            Application.CutCopyMode = False            Dim lastrow As Long, lastcol As Long            Dim rngTemp As Range            With ActiveSheet                If Application.WorksheetFunction.CountA(.Cells) <> 0 Then                    lastrow = .Cells.Find(What:=*, _                                          After:=.Range(A1), _                                          Lookat:=xlPart, _                                          LookIn:=xlFormulas, _                                          SearchOrder:=xlByRows, _                                          SearchDirection:=xlPrevious, _                                          MatchCase:=False).Row                    lastcol = 3                Else                    lastrow = 1: lastcol = 1                End If                Set rngTemp = .Range(A1: & Split(.Cells(, lastcol).Address, $)(1) & lastrow)                Set mychart = ActiveSheet.ChartObjects(1)            End With            WdObj.Visible = True            WdObj.Activate            rngTemp.Select            Application.Wait (Now + TimeValue(0:00:01))            Selection.Copy            DoEvents            Application.Wait (Now + TimeValue(0:00:01))            WdObj.Selection.PasteSpecial            Application.CutCopyMode = False            mychart.Select            Application.Wait (Now + TimeValue(0:00:01))            Selection.Copy            DoEvents            Application.Wait (Now + TimeValue(0:00:01))            WdObj.Selection.PasteSpecial            Application.CutCopyMode = False            Const wdPageBreak = 7            Application.Wait (Now + TimeValue(0:00:01))            WdObj.Selection.InsertBreak (wdPageBreak)            Application.Wait (Now + TimeValue(0:00:01))            Application.CutCopyMode = False            WB.Close SaveChanges:=False            fileName = Dir()        Loop        Dim fname As String        fname = Converted and Combined.docx        Application.CutCopyMode = False        With WdObj            .ChangeFileOpenDirectory C:\Charts\ & vFile & \            .ActiveDocument.SaveAs fileName:=fname        End With        With WdObj            .ActiveDocument.Close            .Quit        End With        Set WdObj = Nothing    NextEnd Sub
Copying data from an Excel sheet to Word
excel;vba