Shorten a Macro
Fraid not, don't forget Chelsea can (will) buy more in January. Sorry state.
--
HTH
RP
(remove nothere from the email address if mailing direct)
"mully" wrote in message
...
Hi Bob
Thanks for info will have a go tomorrow -- got visitors arriving
shortly ---
will either of catch Chelsea???
Cheers
Mully
"Bob Phillips" wrote:
You can fine the first empty column number with
iLastCol = Cells(2,Columns.Count).End(xlToLeft).Column
and use this like so (in my version)
FormatSheet Range("I2:J19"), Sheets("ALTON")
End Sub
Sub FormatSheet(Source As Range, Target As Worksheet)
Dim iLastCol As Long
iLastCol = Cells(2,Columns.Count).End(xlToLeft).Column
Sheets("RPRA").Source.Copy Target.Cells(2,iLastCol)
With Target
--
HTH
RP
(remove nothere from the email address if mailing direct)
"mully" wrote in message
...
Hi Gentlemen
Thanks for all the info managed to get
Managed to get both Duke & Bobs' working OK as there is different info
Rich
wasn't feasible --- just one query the info at the moment is entering
columns
& cells Z2/AA2 range for "ALTON" The question is if I had more info
for
"ALTON" it would have to go into columns AB/AC is it possible for the
macro
to search and find the first empty columns which would be AB/AC then
do
the
business of entering the data which would always be in sheet "(RPRA")
range
"I2:J19)
Once again Thanks --- Have a Happy & Prosperous 2006
Cheers
Mully
"Bob Phillips" wrote:
Split the common stuff into a separate procedure, remove all the
default
settings etc.
For example
Sheets("RPRA").Select
Columns("E:E").TextToColumns Destination:=Range("G1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=True, _
Tab:=False, Semicolon:=False,
Comma:=True,
_
Space:=False, Other:=True, _
FieldInfo:=Array(Array(1, 1),
Array(2,
1),
_
Array(3, 1), Array(4,
1)), _
TrailingMinusNumbers:=True
FormatSheet Range("I316:J323"), Sheets("OLD
GLOSSOP").Range("Z2")
FormatSheet Range("I324:J338"), Sheets("PACKMOOR").Range("Z2")
FormatSheet Range("I2:J19"), Sheets("ALTON").Range("Z2")
End Sub
Sub FormatSheet(Source As Range, Target As Range)
Sheets("RPRA").Source.Copy Target
With Target
.Interior
.ColorIndex = 40
.Pattern = xlSolid
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With .Font
.Name = "Times New Roman"
.Size = 10
.Font.Bold = True
End With
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
End With
End Sub
--
HTH
RP
(remove nothere from the email address if mailing direct)
"mully" wrote in message
...
Hi All ---- Seasons Greetings
Below is a macro I recorded it goes on for 23 Sheets --- I'm only
showing
the 1st three sheets in the macro--- is there a way of cutting
down
on
all
the code that is needed to run the full macro.
Sheets("RPRA").Select
Columns("E:E").Select
Selection.TextToColumns Destination:=Range("G1"),
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True,
Tab:=False, _
Semicolon:=False, Comma:=True, Space:=False, Other:=True,
FieldInfo:= _
Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)),
TrailingMinusNumbers:= _
True
Range("I316:J323").Select
Selection.Copy
Sheets("OLD GLOSSOP").Select
Range("Z2").Select
ActiveSheet.Paste
With Selection.Interior
.ColorIndex = 40
.Pattern = xlSolid
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Font
.Name = "Times New Roman"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Sheets("RPRA").Select
Range("I324:J338").Select
Selection.Copy
Sheets("PACKMOOR").Select
Range("Z2").Select
ActiveSheet.Paste
With Selection.Interior
.ColorIndex = 40
.Pattern = xlSolid
End With
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Font
.Name = "Times New Roman"
.Size = 10
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Selection.Font.Bold = True
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Sheets("RPRA").Select
Range("I2:J19").Select
Selection.Copy
Sheets("ALTON").Select
Range("Z2").Select
ActiveSheet.Paste
With Selection.Interior
.ColorIndex = 40
|