Thanks Alan, I'll try that.

Cheers
Geoff
--
There are 10 types of people in the world - those who understand binary and
those who don't.


"Alan Beban" wrote:

You might try the following untested replacement code; the greater the
value of NumQuarters, the more the improvement:

With wbkCurrentTri.Sheets("Data")
Workbooks.OpenText Filename:=strFilePath & strTxtName, DataType:=xlDelimited
Set wbkTxt = ActiveWorkbook
'Copy the creation date
.Cells(5 + 150 * (NumAcctOrder - 1), 67).Value = _
wbkTxt.Sheets(1).Cells(2, 2).Value
'Copy the data
Set rng = .Range(.Cells(8 + 1 + 150 * (NumAcctOrder - 1),
67), _ .Cells(8 + NumQuarters + 150 * (NumAcctOrder - 1), 67))
Dim arr()
ReDim arr(1 To NumQuarters, 1 To 1)
For q = 1 To NumQuarters 'Loop for the number of quarters
arr(q, 1) = wbkTxt.Sheets(1).Cells(11 + q, 2 + _
NumQuarters - q).Value
Next q
rng.Value = arr
'Close the text file
wbkTxt.Close
End With

Alan Beban

Geoff wrote:
I have a macro which copies data from several .txt files into a spreadsheet
(~12,000 cells per spreadsheet), and around 350 spreadsheets are created this
way. This normally takes around 2-4 minutes per spreadsheet depending on the
machine it runs on, which I would like to shorten a little if possible. I
think I've found a bottleneck in the process in the following portion of the
code:

With wbkCurrentTri.Sheets("Data")
Workbooks.OpenText FileName:=strFilePath & strTxtName, DataType:=xlDelimited
Set wbkTxt = ActiveWorkbook
'Copy the creation date
.Cells(5 + 150 * (NumAcctOrder - 1), 67).Value = _
wbkTxt.Sheets(1).Cells(2, 2).Value
'Copy the data
For q = 1 To NumQuarters 'Loop for the number of quarters
.Cells(8 + q + 150 * (NumAcctOrder - 1), 67).Value = _
wbkTxt.Sheets(1).Cells(11 + q, 2 + NumQuarters - q).Value
Next q
'Close the text file
wbkTxt.Close
End With

But I am stuck on how to improve this section - does anyone have any
suggestions on how to speed this up?

Thanks in advance