Thread: Clean up code
View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Tim Williams[_2_] Tim Williams[_2_] is offline
external usenet poster
 
Posts: 298
Default Clean up code

How about this ?

Sub CopyRangeToNewSheetAndNameValues()

Dim newname

With Sheets("Quote Form")
newname = .Range("h10").Value
.Copy after:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Cou nt)
.Range("B19:B46").ClearContents 'Item Number
.Range("H10:I11").ClearContents 'Invoice Number
.Range("G12:H12").ClearContents 'Address
End With

With ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
.Name = newname
.UsedRange.Value = .UsedRange.Value
End With

End Sub



Tim

"Dorian C. Chalom" wrote in message
...
Please let me know if there is a cleaner way to do this...

Sub CopyRangeToNewSheetAndNameValues()
With Sheets("Quote Form")
newname = .Range("h10")
.Range(.Range("a1"), .Range("a1").SpecialCells(xlLastCell)).Copy
End With

Sheets.Add after:=Sheets(Sheets.Count)

With ActiveSheet
.Paste
.Range(.Range("a1"), .Range("a1").SpecialCells(xlLastCell)).Copy
.Range(.Range("a1"),
.Range("a1").SpecialCells(xlLastCell)).PasteSpecia l Paste:=xlPasteValues
.Name = newname
.Range("a1").Select
End With

Worksheets("Quote Form").Activate
nCol = ActiveCell.SpecialCells(xlLastCell).Column
nRow = ActiveCell.SpecialCells(xlLastCell).Row

For iSht = 1 To Sheets.Count
If Sheets(iSht).Name = "Quote Form" Then
iSrcSht = iSht
End If
If Sheets(iSht).Name = Val(newname) Then
iDstSht = iSht
End If
Next iSht

For iCol = 1 To nCol
nSrcColWidth = Sheets(iSrcSht).Columns(iCol).ColumnWidth
Sheets(iDstSht).Columns(iCol).ColumnWidth = nSrcColWidth
Next iCol

For iRow = 1 To nRow
nSrcRowHeight = Sheets(iSrcSht).Rows(iRow).RowHeight
Sheets(iDstSht).Rows(iRow).RowHeight = nSrcRowHeight
Next iRow

Application.CutCopyMode = False

With Sheets("Quote Form")
.Range("B19:B46").ClearContents 'Item Number
.Range("H10:I11").ClearContents 'Invoice Number
.Range("G12:H12").ClearContents 'Address
End With
End Sub