I have written a code to retrieve data from text files
in a folder than rename and move the files to another
folder.
Now the problem is that this codes runs well till 9
files but for going above count 9 it gives run time
error.....that is subscript out of range.
A difficult problem indeed ....
The code is there
Ashish
-----------------------------------------------------------
Sub cptextfile()
Application.ScreenUpdating = False
Worksheets("temp").Activate
ActiveSheet.Cells.Clear
Dim searchdir As String

searchdir = "C:\ashish\"
With Application.FileSearch


.NewSearch
.Filename = "*.txt"

.LookIn = searchdir



If .Execute(SortBy:=msoSortByFileName, _
SortOrder:=msoSortOrderAscending) > 0 Then


'counter = 0
For i = 1 To .FoundFiles.Count
'counter = counter + 1
f = .FoundFiles(i)
p = "Text;" & f

With
Worksheets("temp").QueryTables.Add(Connection:= _
p,
Destination:=Worksheets("temp").Range("A1"))
.Name = "a"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlWindows
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier =
xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = True
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1, 2, 3, 4,
5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, 18, 19,
20, 21, 22, 23, 24, 25, 26)
.Refresh BackgroundQuery:=False
End With
Call cplastcells
Call Save
Call mvfile

Worksheets("temp").Cells.Clear
Next i
Else
'MsgBox "no files"
End If
End With
Application.ScreenUpdating = True

End Sub

Sub cplastcells()
Dim u As String
' Dim r As String
' Dim t As String
Dim LastColumn As Integer
Dim LastRow As Long
Dim LastCella As Range
Worksheets("temp").Activate
If WorksheetFunction.CountA(Cells) > 0
Then
'Search for any entry, by searching
backwards by Rows.
LastRow = Cells.Find(What:="*",
After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'Search for any entry, by searching
backwards by Columns.
LastColumn = Cells.Find(What:="*",
After:=[A1], _
SearchOrder:=xlByColumns, _

SearchDirection:=xlPrevious).Column
s = LastRow
u = s
End If
'r = "A" & u
't = "G" & u
x = Worksheets("temp").Range("A" &
u).Value
Worksheets("temp").Range(Range("A" &
u), Range("G" & u)).Select
Selection.Copy
Worksheets("a").Activate
Dim z As String
Dim LastCell As Range
With ActiveSheet
Set LastCell = .Cells(.Rows.Count,
"A").End(xlUp)
If IsEmpty(LastCell) Then
'do nothing
Else
Set LastCell = LastCell.Offset(1, 0)
End If
End With
y = LastCell.Row
z = y
Range("A" & z).Select
ActiveSheet.Paste
Worksheets(x).Activate
' Dim z As String
'Dim LastCell As Range
With ActiveSheet
Set LastCell = .Cells(.Rows.Count,
"A").End(xlUp)
If IsEmpty(LastCell) Then
'do nothing
Else
Set LastCell = LastCell.Offset(1, 0)
End If
End With
y = LastCell.Row
z = y
Range("A" & z).Select
ActiveSheet.Paste
End Sub
Sub Save()
ActiveWorkbook.Save
End Sub
Sub SaveName()
ActiveWorkbook.SaveAs Filename:="C:\My
documents\as\Mis.xls"
End Sub

Sub mvfile()
Dim o, n, myname


Dim u, f As String

Dim LastColumn As Integer
Dim LastRow As Long
Dim LastCella As Range
Worksheets("temp").Activate
If WorksheetFunction.CountA(Cells) > 0
Then
'Search for any entry, by searching
backwards by Rows.
LastRow = Cells.Find(What:="*",
After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'Search for any entry, by searching
backwards by Columns.
LastColumn = Cells.Find(What:="*",
After:=[A1], _
SearchOrder:=xlByColumns, _

SearchDirection:=xlPrevious).Column
s = LastRow
u = s
End If
l = Worksheets("temp").Range("A" & u).Value
Mo = Month(Now())
da = Day(Now())

If Mo = 0 Then
Mo = 12
Yr = Format(Now(), "YYYY") - 1
Else
Yr = Format(Now(), "YYYY")
End If

Select Case Mo
Case 1
MMM = "Jan"
Case 2
MMM = "Feb"
Case 3
MMM = "Mar"
Case 4
MMM = "Apr"
Case 5
MMM = "May"
Case 6
MMM = "Jun"
Case 7
MMM = "Jul"
Case 8
MMM = "Aug"
Case 9
MMM = "Sep"
Case 10
MMM = "Oct"
Case 11
MMM = "Nov"
Case 12
MMM = "Dec"
End Select

myname = l & da & MMM & Yr & ".txt"

With Application.FileSearch
.NewSearch
.Filename = "*.txt"
.LookIn = "C:\ashish\"

i = 1
If .Execute > 0 Then
'counter = 0
'For i = 1 To .FoundFiles.Count
'counter = counter + 1
f = .FoundFiles(i)


o = f: n = "C:\b\" & myname
Name o As n
'Next i
End If

End With



'MsgBox (Myname)
'Application.ActiveWorkbook.SaveCopyAs (MyName)

End Sub