#1   Report Post  
Posted to microsoft.public.excel.programming
al al is offline
external usenet poster
 
Posts: 363
Default Macro Help

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
  #2   Report Post  
Posted to microsoft.public.excel.programming
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
  #3   Report Post  
Posted to microsoft.public.excel.programming
al al is offline
external usenet poster
 
Posts: 363
Default Macro Help

Thanks for the reply
Sorry
1)Myfile.xls should be Myfile.txt
2)The sheet does exist in Myotherfile.xls and existing data should be
cleared and the new data pasted in.
Al

"Dave Peterson" wrote:

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

  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 35,218
Default Macro Help

I actually deleted sheet2 and just recreated it. That's almost equivalent
clearing Sheet2 and pasting in.

Did the newer version not work ok?

Al wrote:

Thanks for the reply
Sorry
1)Myfile.xls should be Myfile.txt
2)The sheet does exist in Myotherfile.xls and existing data should be
cleared and the new data pasted in.
Al

"Dave Peterson" wrote:

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


--

Dave Peterson
  #5   Report Post  
Posted to microsoft.public.excel.programming
al al is offline
external usenet poster
 
Posts: 363
Default Macro Help

Yes thanks! I got it to work, I had a typo


"Dave Peterson" wrote:

I actually deleted sheet2 and just recreated it. That's almost equivalent
clearing Sheet2 and pasting in.

Did the newer version not work ok?

Al wrote:

Thanks for the reply
Sorry
1)Myfile.xls should be Myfile.txt
2)The sheet does exist in Myotherfile.xls and existing data should be
cleared and the new data pasted in.
Al

"Dave Peterson" wrote:

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


--

Dave Peterson



Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Macro recorded... tabs & file names changed, macro hangs Steve Excel Worksheet Functions 3 October 30th 09 11:41 AM
Macro Help Needed - Excel 2007 - Print Macro with Auto Sort Gavin Excel Worksheet Functions 0 May 17th 07 01:20 PM
how to count/sum by function/macro to get the number of record to do copy/paste in macro tango Excel Programming 1 October 15th 04 01:16 PM
macro to delete entire rows when column A is blank ...a quick macro vikram Excel Programming 4 May 3rd 04 08:45 PM
Start Macro / Stop Macro / Restart Macro Pete[_13_] Excel Programming 2 November 21st 03 05:04 PM


All times are GMT +1. The time now is 12:41 PM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"