Macro Help
Some questions first...
Myfile.xls seems like a pretty weird name for a text file. Are you sure it's
correct and that it's really a text file?
Second, in myotherfile.xls, does sheet2 exist?
If yes, how does this data get added? Does it get pasted to the bottom of
existing data? Or does the existing data get cleared out and then the new data
get pasted in?
If no, I guess I don't have a question!
This opens the file, renames the imported sheet to Sheet2.
Deletes Sheet2 (if it exists)
copies the imported worksheet to thisworkbook (as Sheet2)
then does the work.
Option Explicit
Sub Trash2()
Dim curWks As Worksheet
Dim newWks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim oCol As Long
Dim rngToCopy As Range
Dim ImpWks As Worksheet
Workbooks.OpenText Filename:="C:\MyPath\Myfile.xls", Origin:=437, _
StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), _
Array(2, 1), Array(5, 1), Array(8, 1), Array(12, 1), _
Array(16, 1), Array(20, 1), Array(24, 1), Array(28, 1), _
Array(32, 1), Array(36, 1), Array(40, 1), Array(44, 1), _
Array(48, 1), Array(52, 1), Array(56, 1), Array(60, 1), _
Array(64, 1), Array(68, 1), Array(72, 1), Array(76, 1), _
Array(80, 1), Array(84, 1), Array(88, 1), Array(92, 1), _
Array(96, 1), Array(100, 1)), TrailingMinusNumbers:=True
Set ImpWks = ActiveSheet
'wipe out any existing worksheet named Sheet2
On Error Resume Next
Application.DisplayAlerts = False
ThisWorkbook.Worksheets("Sheet2").Delete
Application.DisplayAlerts = True
On Error GoTo 0
ImpWks.Name = "Sheet2"
ImpWks.Copy _
befo=ThisWorkbook.Worksheets(1)
ImpWks.Parent.Close savechanges:=False
Set curWks = Worksheets("sheet2")
Set newWks = Worksheets.Add
With curWks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
oCol = 0
For iRow = FirstRow To LastRow
oCol = oCol + 1
newWks.Cells(1, oCol).Value _
= .Cells(iRow, "A").Value & "-" _
& .Cells(iRow, "B").Value & "-" _
& .Cells(iRow, "C").Value
Set rngToCopy = .Range(.Cells(iRow, "D"), _
.Cells(iRow, .Columns.Count).End(xlToLeft))
rngToCopy.Copy
newWks.Cells(2, oCol).PasteSpecial Transpose:=True
Next iRow
End With
newWks.UsedRange.Columns.AutoFit
Application.CutCopyMode = False
End Sub
Al wrote:
How would I modify this macro to run in myotherfile.xls and copy the data on
sheet2 rather than addins a new sheet in MyFile.xls.
Sub Trash()
Workbooks.OpenText Filename:="C:\MyPath\Myfile.xls", Origin:=437, _
StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1),
Array(2, _
1), Array(5, 1), Array(8, 1), Array(12, 1), Array(16, 1), Array(20,
1), Array(24, 1), Array( _
28, 1), Array(32, 1), Array(36, 1), Array(40, 1), Array(44, 1),
Array(48, 1), Array(52, 1), _
Array(56, 1), Array(60, 1), Array(64, 1), Array(68, 1), Array(72,
1), Array(76, 1), Array( _
80, 1), Array(84, 1), Array(88, 1), Array(92, 1), Array(96, 1),
Array(100, 1)), _
TrailingMinusNumbers:=True
Dim curWks As Worksheet
Dim newWks As Worksheet
Dim iRow As Long
Dim FirstRow As Long
Dim LastRow As Long
Dim oCol As Long
Dim rngToCopy As Range
Set curWks = Worksheets("sheet1")
Set newWks = Worksheets.Add
With curWks
FirstRow = 1
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
oCol = 0
For iRow = FirstRow To LastRow
oCol = oCol + 1
newWks.Cells(1, oCol).Value _
= .Cells(iRow, "A").Value & "-" _
& .Cells(iRow, "B").Value & "-" _
& .Cells(iRow, "C").Value
Set rngToCopy = .Range(.Cells(iRow, "D"), _
.Cells(iRow, .Columns.Count).End(xlToLeft))
rngToCopy.Copy
newWks.Cells(2, oCol).PasteSpecial Transpose:=True
Next iRow
End With
newWks.UsedRange.Columns.AutoFit
Application.CutCopyMode = False
End Sub
--
Dave Peterson
|