Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Clean up code
I don't know why it wouldn't have worked before...
UsedRange is just that: the "used range" on the sheet, ie, it contains (usually) all cells on a sheet which have been "used". It's much quicker than doing something like this: with ActiveSheet.cells .value = .value end with Tim "Dorian C. Chalom" wrote in message ... 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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
clean up code a little | Excel Discussion (Misc queries) | |||
help me clean up this code | Excel Programming | |||
Clean up code. | Excel Programming | |||
Help clean up this code... | Excel Programming | |||
Clean up code using WITHs | Excel Programming |