Thread: Clean up code
View Single Post
  #1   Report Post  
Posted to microsoft.public.excel.programming
Dorian C. Chalom Dorian C. Chalom is offline
external usenet poster
 
Posts: 17
Default Clean up code

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)).PasteSpeci al 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