Thread: Clean up code
View Single Post
  #3   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

Tim;

This works really well...but why?
When I tried to Copy the sheet before it gave me errors because of the
lookup formulas attached to other workbooks. But in your code it works
great.

Also what does the UsedRange do?

Thank you

"Tim Williams" wrote in message
...
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