vba efficiency with copy/paste

[DDT~123]

Greetings all, I have a large spreadsheet which copies 100 text files into 100 worksheets, then embeds the compiled data into an email which sends every 30 minutes via a scheduled task. Each time the vba runs I have to stop what I'm doing due to the clipboard being tied up until after the file sends. I'd really like to speed things up a bit (or free up my clipboard) so it'll not be so disruptive to my other tasks. I'm including only the repetitive portion for a couple of the files as I believe the code I'm using for emailing is efficient as is. Any help in rewriting the code to make it more efficient would be greatly appreciated

Public Sub ImportCMS()

Application.ScreenUpdating = FalseApplication.Calculation = xlCalculationManual
Dim File1, File2,... As String 
Dim lastMod As String
File1 = ActiveWorkbook.Name
Sheets("account1").SelectRange("A10:R64").ClearContentsWS = ActiveSheet.Name
lastMod = FileDateTime("C:\Users\dturner\Desktop\ServiceLevelsSMS\PrevDayScriptOutput\account1.txt")
Range("A67") = lastModFile2 = "C:\Users\dturner\Desktop\ServiceLevelsSMS\IntervalScriptOutput\account1.txt"Workbooks.Open File2wFile = ActiveWorkbook.NameRange("A1:R55").SelectSelection.CopyWindows(File1).ActivateSheets(WS).ActivateRange("A10").ActivateSelection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=FalseApplication.CutCopyMode = FalseWorkbooks(wFile).Close FalseIf ActiveSheet.Name = "Sheet1" ThenApplication.GoTo Reference:="mTop"End If

Sheets("account2").SelectRange("A10:R64").ClearContentsWS = ActiveSheet.NamelastMod = FileDateTime("C:\Users\dturner\Desktop\ServiceLevelsSMS\PrevDayScriptOutput\account2.txt")Range("A67") = lastModFile3 = "C:\Users\dturner\Desktop\ServiceLevelsSMS\IntervalScriptOutput\account2.txt"Workbooks.Open File3wFile = ActiveWorkbook.NameRange("A1:R55").SelectSelection.CopyWindows(File1).ActivateSheets(WS).ActivateRange("A10").ActivateSelection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _:=False, Transpose:=FalseApplication.CutCopyMode = FalseWorkbooks(wFile).Close FalseIf ActiveSheet.Name = "Sheet1" ThenApplication.GoTo Reference:="mTop"End If

Application.Calculation = xlCalculationAutomatic
(...code for emailing)
Application.ScreenUpdating = True

 

[DDT~123]

Sorry that looks a bit garbled. Here's a cleaner view:

Public Sub ImportCMS()

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim File1, File2,... As String 
Dim lastMod As String

File1 = ActiveWorkbook.Name

Sheets("account1").Select
Range("A10:R64").ClearContents
WS = ActiveSheet.Name
lastMod = FileDateTime("C:\Users\dturner\Desktop\ServiceLevelsSMS\PrevDayScriptOutput\account1.txt")
Range("A67") = lastMod
File2 = "C:\Users\dturner\Desktop\ServiceLevelsSMS\IntervalScriptOutput\account1.txt"
Workbooks.Open File2
wFile = ActiveWorkbook.Name
Range("A1:R55").Select
Selection.Copy
Windows(File1).Activate
Sheets(WS).Activate
Range("A10").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Workbooks(wFile).Close False
If ActiveSheet.Name = "Sheet1" Then
Application.GoTo Reference:="mTop"
End If

Sheets("account2").Select
Range("A10:R64").ClearContents
WS = ActiveSheet.Name
lastMod = FileDateTime("C:\Users\dturner\Desktop\ServiceLevelsSMS\PrevDayScriptOutput\account2.txt")
Range("A67") = lastMod
File3 = "C:\Users\dturner\Desktop\ServiceLevelsSMS\IntervalScriptOutput\account2.txt"
Workbooks.Open File3
wFile = ActiveWorkbook.Name
Range("A1:R55").Select
Selection.Copy
Windows(File1).Activate
Sheets(WS).Activate
Range("A10").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Workbooks(wFile).Close False
If ActiveSheet.Name = "Sheet1" Then
Application.GoTo Reference:="mTop"
End If

Application.Calculation = xlCalculationAutomatic
(...code for emailing)
Application.ScreenUpdating = True

End Sub

[/QUOTE]

 

[offthelip]

You can avoid using the clipboard and speed up your code at the same time by using a variant array to do the copy and paste replace this code:

Workbooks.Open File2wFile = ActiveWorkbook.Name
Range("A1:R55").Select
Selection.Copy
Windows(File1).Activate
Sheets(WS).Activate
Range("A10").Activate
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Workbooks(wFile).Close False

with this code

Dim inarr As Variant


Workbooks.Open File2
wFile = ActiveWorkbook.Name
inarr = Range("A1:R55")
Windows(File1).Activate
Sheets(WS).Activate
Range("A10:r65") = inarr


Workbooks(wFile).Close False

And similar the second time it occurs
Note you only need the dim inarr statement once in the module, but you can use the same range again and again