Transpose > out of range error

J

javamom

Apologies for harping on this! I was supposed to have things finished
by a meeting this morning and I'm still trying to get my head wrapped
around VBA.

I can now open text files as semicolon delimited but I cannot get to
another workbook to paste/append the transposed data. There is an out
of range error at "Set dataBk = Workbooks("data.xls")" but I can see
the file and it does have worksheets.

Feels like I'm close, but maybe I'm really moving in the wrong
direction. Wondering if I've caused a problem by my unskilled use of an
array. Here is the script:

Sub OpenMultipleUserSelectedFiles()
Dim rng1 As Range
Dim rng2 As Range
Dim tempBk As Workbook
Dim dataBk As Workbook
Dim filearray As Variant

filearray = Application.GetOpenFilename _
("Text Files (*.*),*.*,PRN Files (*.prn),*.prn", , , , True)
If IsArray(filearray) Then
For i = LBound(filearray) To UBound(filearray)
Workbooks.OpenText filearray(i), _
Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited,
TextQualifier _
:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:= _
True, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1)

Set tempBk = ActiveWorkbook
With tempBk.Worksheets(1)
Set rng1 = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With

Set dataBk = Workbooks("data.xls")
With dataBk.Worksheets(1)
Set rng2 = .Range(.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
End With

rng1.Copy
rng2.PasteSpecial xlValues, Transpose:=True
bk.Close Savechanges:=False
Next i
Else:
MsgBox "You clicked cancel"
End If
End Sub

Any help much appreciated! Trish
 
K

kounoike

Is your Workbooks("data.xls") opened? if not, you should open it before
to set dataBk. i think it's better before getting into for loop. you
need not to set dataBk so maney times, i think.
and i think
Set rng2 = .Range(.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0))
is not appropriate. in my thought, it should be
Set rng2 =.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)

keizi
 
J

javamom

WORKING!!! Thanks so much! The help has been wonderful -- a lifesaver.
Here's the final version:

Sub OpenMultipleUserSelectedFiles()
Dim rng1 As Range
Dim rng2 As Range
Dim tempBk As Workbook
Dim dataBk As Workbook
Dim filearray As Variant

filearray = Application.GetOpenFilename _
("Text Files (*.*),*.*,PRN Files (*.prn),*.prn", , , , True)
If IsArray(filearray) Then
For i = LBound(filearray) To UBound(filearray)
Workbooks.OpenText filearray(i), _
Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited,
TextQualifier _
:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:= _
True, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1)

Set tempBk = ActiveWorkbook
With tempBk.Worksheets(1)
Set rng1 = .Range(.Cells(1, 1), .Cells(Rows.Count, 1).End(xlUp))
End With

On Error Resume Next
Set dataBk = Workbooks("data.xls")
On Error GoTo 0
If dataBk Is Nothing Then
Set dataBk = Workbooks.Open("C:\MyTextFiles\data.xls")
End If

With dataBk.Worksheets(1)
Set rng2 = .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
dataBk.Save
End With

rng1.Copy
rng2.PasteSpecial xlValues, Transpose:=True
tempBk.Close Savechanges:=False
Next i
Else:
MsgBox "You clicked cancel"
End If
End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top