PDA

View Full Version : Subscript out of range for importing files



cab0008
06-30-2010, 07:29 PM
Hello everyone,

I was hoping that someone may be able to point me in the right direction for the syntax of referring to a workbook with a variant name.
I'm trying to import multiple files (all with the same configuration) to be sheets on one single workbook.
I also want the sheet name to be that of the file that was imported.
The code I have written gives me a "subscript out of range" error.

Here is the code I am having a problem with:


Sub selectfilesimport()
'Define Vars
Dim fn As Variant, f As Integer
'Import txt files
fn = Application.GetOpenFilename("UV-Vis Spectra,*.asc", 1, "Select One Or More File To Open", , True)
If TypeName(fn) = "Boolean" Then Exit Sub
For f = 1 To UBound(fn)
Debug.Print "Selected file #" & f & ": " & fn(f)
Workbooks.Open fn(f)

'Remove extraneous text
Rows("1:2").Select
Selection.Delete Shift:=xlUp
Rows("2:84").Select
Selection.Delete Shift:=xlUp

'Get workbook name and place in A1 Cell
Range("A1").Value = ActiveWorkbook.Name

'Copy txt and put in active excel file
Range("A1:B992").Copy
Workbooks("AnalysisRunner").Worksheets(f + 1).Activate
Range("A1").PasteSpecial
Application.CutCopyMode = False

'Name Sheet A1 cell
Sheets(f + 1).Name = Range("A1").Value

'Close the opened importing file
Workbooks(fn(f)).Close (False) ''''''''ERROR HERE

'go to A1 cell of the now imported sheet
Workbooks("AnalysisRunner").Worksheets(f + 1).Range("A1").Select

Next f
End Sub


any help with this problem is greatly appreciated.

Bob Phillips
07-01-2010, 01:50 AM
Untested



Sub selectfilesimport()
'Define Vars
Dim fn As Variant, f As long
Dim thisWB as workbook
Dim thatWB as workbook

Set thisWB = Workbooks("AnalysisRunner")

'Import txt files
fn = Application.GetOpenFilename("UV-Vis Spectra,*.asc", 1, "Select One Or More File To Open", , True)
If TypeName(fn) = "Boolean" Then Exit Sub
For f = 1 To UBound(fn)

Debug.Print "Selected file #" & f & ": " & fn(f)
Set thatWB = Workbooks.Open(fn(f))

With thatWB.Worksheets(1)

'Remove extraneous text
.Rows("1:2").Delete Shift:=xlUp
.Rows("2:84").Delete Shift:=xlUp

'Get workbook name and place in A1 Cell
. Range("A1").Value = ActiveWorkbook.Name

'Copy txt and put in active excel file
.Range("A1:B992").Copy ThisWB.Worksheets(f + 1).Range("A1")

'Name Sheet A1 cell
thisWB.Worksheets(f + 1).Name = .Range("A1").Value

'Close the opened importing file
thatWB.Close False

'go to A1 cell of the now imported sheet
thisWB.Worksheets(f + 1).Range("A1").Select
End With
Next f
End Sub