HiveBrain v1.2.0
Get Started
← Back to all entries
patternMinor

Copying data from an Excel sheet to Word

Submitted by: @import:stackexchange-codereview··
0
Viewed 0 times
excelsheetwordcopyingfromdata

Problem

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:=xlFo

Solution

Things you could try:

-
Set shorter wait times. This shows you how. This is likely the main source of delay. You can assess if this is true by timing the total time, and calculating the time taken with each vfile.

-
Avoid Selecting unless mandatory. For instance, replace

ActiveSheet.Columns("C").Select
ActiveSheet.Paste


with

ActiveSheet.Columns("C").PasteSpecial

Code Snippets

ActiveSheet.Columns("C").Select
ActiveSheet.Paste
ActiveSheet.Columns("C").PasteSpecial

Context

StackExchange Code Review Q#95437, answer score: 6

Revisions (0)

No revisions yet.