D
Dorian C. Chalom
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)).PasteSpecial 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
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)).PasteSpecial 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