Add new Worksheet after filling first 256 columns
Hello,
The following macro (thanks to Tom O.), will copy a single column of
data from many text files (*.mhl extension) onto the same worksheet.
Now, I have over 1000 of these text files. The macro works until the
first 256 columns of the first worksheet are filled and then it
produces an error. I know that you cannot add more than 256 columns.
So how do I carry on filling columns of subsequent worksheets for all
1000 files???
Many thanks,
Bharesh
Option Explicit
Sub Getmhl()
Dim wkbk As Workbook
Dim shDest As Worksheet
Dim col As Long
Dim i As Long
Dim rng As Range
Dim rng1 As Range
Dim rng2 As Range
Set shDest = ThisWorkbook.ActiveSheet
shDest.UsedRange.ClearContents
col = 1
With Application.FileSearch
.NewSearch
.LookIn = "C:\Documents and Settings\My Documents"
.SearchSubFolders = False
.FileName = "*.mhl"
.FileType = msoFileTypeAllFiles
If .Execute() 0 Then
For i = 1 To .FoundFiles.Count
Workbooks.OpenText _
FileName:=.FoundFiles(i) ' _
' Origin:=437, _
' StartRow:=1, _
' DataType:=xlDelimited, _
' TextQualifier:=xlDoubleQuote, _
' ConsecutiveDelimiter:=False, _
' Tab:=True, Semicolon:=False, _
' Comma:=False, Space:=False, _
' Other:=False, FieldInfo:=Array(1, 1), _
' TrailingMinusNumbers:=True
Set wkbk = ActiveWorkbook
With wkbk.Worksheets(1)
Set rng = .Range(.Cells(1, 1), _
.Cells(Rows.Count, 1).End(xlUp))
End With
rng.Copy Destination:=shDest.Cells(2, col)
shDest.Cells(1, col) = wkbk.Name
Set rng1 = shDest.Cells(Rows.Count, col).End(xlUp)(2)
Set rng2 = shDest.Range(shDest.Cells(2, col), rng1(0))
rng1.Formula = "=Average(" & rng2.Address & ")"
rng1(2).Formula = "=Stdev(" & rng2.Address & ")"
rng1(3).Formula = "=Count(" & rng2.Address & ")"
wkbk.Close SaveChanges:=False
col = col + 1
Next i
Else
MsgBox "There were no files found."
End If
End With
End Sub
|