Repeat macro for all open workbooks
You need to wrap the code in say
Dim oWB As Workbook
For Each oWB In Workbooks
.... your code
Next oWB
then in your code when you refer to activeworkbook, such as
For Each wks In ActiveWorkbook.Worksheets
You need to refer to the workbook object
For Each wks In oWB.Worksheets
--
HTH
Bob Phillips
(remove nothere from email address if mailing direct)
<Andy wrote in message ...
Hi
Thanks for reading this!
I've been purloining bits of code from various posts - and also used the
macro recorder to come up with this:
Sub TillFileImport()
'
' Macro1 Macro
' Macro recorded 20/02/2006 by Andy
'
'
Dim myfile As Variant
'if you know the drive and folder:
'otherwise, just let the user point and click
ChDrive "C"
ChDir "C:\Documents and Settings\Andy\Desktop"
myfile = Application.GetOpenFilename(filefilter:="*.txt, (*.txt)", _
Title:="What File?")
If myfile = False Then
'you pressed cancel
MsgBox "Ok. Quitting"
Exit Sub
End If
Workbooks.OpenText Filename:=myfile, Origin:=xlWindows, _
StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1),
Array(8, _
1), Array(9, 1), Array(42, 1), Array(49, 1), Array(59, 1),
Array(67,
1), Array(78, 1), Array _
(82, 1), Array(87, 1), Array(91, 1), Array(96, 1), Array(102, 1))
Cells.Select
Selection.Sort Key1:=Range("A1"), Order1:=xlAscending,
HEADER:=xlGuess,
_
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'remove rows with text values in column A
Application.ScreenUpdating = False
On Error Resume Next
Columns("A:A").SpecialCells(xlCellTypeConstants, 2) _
.EntireRow.Delete
On Error GoTo 0
Application.ScreenUpdating = True
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Selection.Font.Bold = True
ActiveCell.FormulaR1C1 = "SKU"
Rows("1:1").Select
Range("B1").Activate
ActiveCell.FormulaR1C1 = "REF"
Range("C1").Select
ActiveCell.FormulaR1C1 = "DESC"
Range("D1").Select
ActiveCell.FormulaR1C1 = "QTY"
Range("E1").Select
ActiveCell.FormulaR1C1 = "PRICE"
Range("F1").Select
ActiveCell.FormulaR1C1 = "DISC"
Range("G1").Select
ActiveCell.FormulaR1C1 = "TOTAL"
Range("H1").Select
ActiveCell.FormulaR1C1 = "TRANS"
Range("I1").Select
ActiveCell.FormulaR1C1 = "ASS"
Range("J1").Select
ActiveCell.FormulaR1C1 = "TILL"
Range("K1").Select
ActiveCell.FormulaR1C1 = "TIME"
Range("L1").Select
ActiveCell.FormulaR1C1 = "GP%"
Range("M1").Select
ActiveCell.FormulaR1C1 = "REF2"
Range("L1").Select
On Error Resume Next ' In case there are no blanks
Columns("A:A").SpecialCells(xlCellTypeBlanks).Enti reRow.Delete
ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
On Error Resume Next ' In case there are no blanks
Columns("C:C").SpecialCells(xlCellTypeBlanks).Enti reRow.Delete
ActiveSheet.UsedRange 'Resets UsedRange for Excel 97
' = = = = = = = = = = = = = = = =
' Use of CDbl suggested by Peter Surcouf
' Program by Dana DeLouis,
' = = = = = = = = = = = = = = = =
Dim rng As Range
Dim bigrng As Range
On Error Resume Next
Set bigrng = Cells.SpecialCells(xlConstants, xlTextValues).Cells
If bigrng Is Nothing Then Exit Sub
For Each rng In bigrng.Cells
rng = CDbl(rng)
Next
'Reset used range
Dim myLastRow As Long
Dim myLastCol As Long
Dim wks As Worksheet
Dim dummyRng As Range
For Each wks In ActiveWorkbook.Worksheets
With wks
myLastRow = 0
myLastCol = 0
Set dummyRng = .UsedRange
On Error Resume Next
myLastRow = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhole, _
searchdirection:=xlPrevious, _
searchorder:=xlByRows).Row
myLastCol = _
.Cells.Find("*", after:=.Cells(1), _
LookIn:=xlFormulas, lookat:=xlWhole, _
searchdirection:=xlPrevious, _
searchorder:=xlByColumns).Column
On Error GoTo 0
If myLastRow * myLastCol = 0 Then
.Columns.Delete
Else
.Range(.Cells(myLastRow + 1, 1), _
.Cells(.Rows.Count, 1)).EntireRow.Delete
.Range(.Cells(1, myLastCol + 1), _
.Cells(1, .Columns.Count)).EntireColumn.Delete
End If
End With
Next wks
End Sub
Basically, it asks for a text file and mashes it about so it is useable.
If
possible I would like this to run on every open workbook, rather than ask
for a specific file. I would like to be able to open a dozen text files
and
hit the button for this to run on all of them.
Thanks for your help - whoever you may be!
Cheers.
Andy.
|