Thread: Macro Help
View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Dave Peterson Dave Peterson is offline
external usenet poster
 
Posts: 35,218
Default 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