Transpose out of range error
 

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

Transpose out of range error
 

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

"javamom" wrote in message
oups.com...
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

Transpose out of range error
 

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