View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
joel[_627_] joel[_627_] is offline
external usenet poster
 
Posts: 1
Default Adjust data range without opening multiple excel files


You can't read a workbook without openning it or using the ADO method.
I can fix the code to run much quicker. try these changes. I didn't
test the changes so try it in two new folders on one file before running
it on a whole directory.

change these two lines to test code.
SourceFolder = "M:\CA\SP\Bdgt\BAl\dem3\"
DestFolder = "M:\CA\SP\Bdgt\BAl\dem4"

Changing directories, selecting cells, copying rows one at a time is
extremely slow.



Sub ChgHeader()

Application.Calculation = xlCalculationManual

Dim wb As Workbook
Dim WBName As String
Dim WhatFolder As String
Dim i As Long
Dim Lstrow As Long

Application.DisplayAlerts = False
Application.ScreenUpdating = False

SourceFolder = "M:\CA\SP\Bdgt\BAl\dem3\"
DestFolder = "M:\CA\SP\Bdgt\BAl\dem4\"

WBName = Dir(SourceFolder & "*.xls", vbNormal)
Do Until WBName = vbNullString

Set wb = Workbooks.Open(SourceFolder & WBName)
With wb.Worksheets("P+L")
Lstrow = .Cells(Rows.Count, "A").End(xlUp).Row
If Lstrow = 5 Then
Set CopyRange = .Range("A5:A" & Lstrow)
CopyRange.Copy _
Destination:=.Range("B5")
Else
MsgBox ("It appears that the file is empty : " & WBName)
Exit Do
End If

wb.SaveAs Filename:=DestFolder & WBName, FileFormat:=xlNormal

wb.Close SaveChanges:=True
WBName = Dir()
End With
Loop

Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'Application.EnableEvents = True

End Sub


--
joel
------------------------------------------------------------------------
joel's Profile: 229
View this thread: http://www.thecodecage.com/forumz/sh...d.php?t=175500

Microsoft Office Help