Code Help

[alexm999]

Here's the code... Any ideas?
I have the following directories:

C:\UDC\101
C:\UDC\102
C:\UDC\103
C:\UDC\104
C:\UDC\105

the sheets are 101-JAN04,102-JAN04 and so on to 105-JAN04



Sub Macro1()
Application.DisplayAlerts = False
If ActiveSheet.Name = "101-JAN04" Then
Folder = "c:\UDC\101\"
End If
Workbooks.OpenText Filename:="c:\UDC\101\1.TXT", Origin:=xlWindows
StartRow _
:=7, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=False
Comma:=False, _
Space:=True, Other:=False, FieldInfo:=Array(Array(1, 1)
Array(2, 1), Array(3 _
, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1)
Array(8, 1))
If Range("a:a").Find(what:="DEV") Is Nothing Then
Range("a16").EntireRow.Insert shift:=xlDown
End If
Windows("1.txt").Activate
Range("E62").Select
Selection.Copy
Windows("DAILY OPERATIONS_2004.xls").Activate
Range("AL9").Select
ActiveSheet.Paste
Range("AM9").Select
Windows("1.txt").Activate
Range("I62").Select
Application.CutCopyMode = False
Selection.Copy
Windows("DAILY OPERATIONS_2004.xls").Activate
ActiveSheet.Paste
Windows("1.txt").Activate
Range("F13").Select
Selection.Copy
Windows("DAILY OPERATIONS_2004.xls").Activate
Range("C9").Select
ActiveSheet.Paste
Range("E9").Select
Windows("1.TXT").Activate
Range("F14").Select
Application.CutCopyMode = False
Selection.Copy
Windows("DAILY OPERATIONS_2004.xls").Activate
ActiveSheet.Paste
Range("J9").Select
Windows("1.TXT").Activate
Range("E17").Select
Application.CutCopyMode = False
Selection.Copy
Windows("DAILY OPERATIONS_2004.xls").Activate
ActiveSheet.Paste
Range("K9").Select
Windows("1.TXT").Activate
Range("G18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("DAILY OPERATIONS_2004.xls").Activate
ActiveSheet.Paste
ActiveWindow.LargeScroll ToRight:=2
Range("AI9").Select
Windows("1.TXT").Activate
Range("F18").Select
Application.CutCopyMode = False
Selection.Copy
Windows("DAILY OPERATIONS_2004.xls").Activate
ActiveSheet.Paste
Windows("1.TXT").Activate
ActiveWindow.Close
ActiveWindow.LargeScroll ToRight:=-2
ActiveWindow.ScrollColumn = 1
Application.DisplayAlerts = True
End Su

 

[Rob van Gelder]

I've got the answers, but you haven't asked the question.

What do you want to know? Be specific.

 

[Bob Phillips]

This is the third thread on the same question . Methinks you are testing our
willingness to help.

Bob

 

[Tom Ogilvy]

Sub Macro1()
Dim rng As Range, sh As Worksheet
Dim sh2 As Worksheet, sFile As String
Dim Folder As String

' sFile just demo's that you could set other activesheet
' dependent data.

Application.DisplayAlerts = False
If ActiveSheet.Name = "101-JAN04" Then
Folder = "c:\UDC\101\"
sFile = "DAILY OPERATIONS_2004.xls"
Elseif Activesheet.Name = "102-JAN04"
Folder = "c:\UDC\102\"
sFile = "DAILY OPERATIONS_2004.xls"
Elseif Activesheet.Name = "103-JAN04"
Folder = "c:\UDC\103\"
sFile = "DAILY OPERATIONS_2004.xls"
Elseif Activesheet.Name = "104-JAN04"
Folder = "c:\UDC\104\"
sFile = "DAILY OPERATIONS_2004.xls"
Elseif Activesheet.Nmae = "105-JAN04"
Folder = "c:\UDC\105\"
sFile = "DAILY OPERATIONS_2004.xls"
End If

Workbooks.OpenText FileName:=Folder & "1.TXT", _
Origin:=xlWindows, _
StartRow:=7, _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, _
Tab:=True, _
Semicolon:=False, _
Comma:=False, _
Space:=True, _
Other:=False, _
FieldInfo:=Array(Array(1, 1), _
Array(2, 1), Array(3, 1), _
Array(4, 1), Array(5, 1), _
Array(6, 1), Array(7, 1), _
Array(8, 1))

Set sh = ActiveSheet

Set rng = sh.Range("a:a").Find(what:="DEV")

If rng Is Nothing Then
sh.Range("a16").EntireRow.Insert shift:=xlDown
Exit Sub
End If

Set sh2 = Windows(sFile).ActiveSheet
sh.Range("E62").Copy Destination:=sh2.Range("AL9")
sh.Range("I62").Copy Destination:=sh2.Range("AM9")
sh.Range("F13").Copy Destination:=sh2.Range("C9")
sh.Range("F14").Copy Destination:=sh2.Range("E9")
sh.Range("E17").Copy Destination:=sh2.Range("J9")
sh.Range("G18").Copy Destination:=sh2.Range("K9")
sh.Range("F18").Copy Destination:=sh2.Range("AI9")
Workbooks("1.Text").Close

Application.DisplayAlerts = True
End Sub