josephgunter163
New Member
- Joined
- Nov 27, 2013
- Messages
- 6
Hey team,
Here is some code I have adapted to my own use. I'm working with a budget spreadsheet and want to create a summery sheet of the department totals (police, fire, accounting, Etc.). the code creates a new work sheet called "test" and then populates it with only the rows labeled Total from the "data" sheet.
Trouble is I only want the cell values but the code is grabbing the formulas and giving me ref# errors in the new "test" sheet. I tried pastespecial xlpastevalues but it is kicking a 1004 error back to me.
Any thoughts?
Here is some code I have adapted to my own use. I'm working with a budget spreadsheet and want to create a summery sheet of the department totals (police, fire, accounting, Etc.). the code creates a new work sheet called "test" and then populates it with only the rows labeled Total from the "data" sheet.
Trouble is I only want the cell values but the code is grabbing the formulas and giving me ref# errors in the new "test" sheet. I tried pastespecial xlpastevalues but it is kicking a 1004 error back to me.
Any thoughts?
Code:
Private Sub CommandButton7_Click() ' basic test buton
Dim objWorksheet As Worksheet
Dim rngBurnDown As Range
Dim rngCell As Range
Dim strPasteToSheet As String
'Used for the new worksheet we are pasting into
Dim objNewSheet As Worksheet
Dim rngNextAvailbleRow As Range
' add new sheet name test
Set sht = Sheets.Add
ActiveSheet.Name = "test"
Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
'Defines the worksheet with the data
Set objWorksheet = ActiveWorkbook.Sheets("data")
'define range to the last cell.
Set rngBurnDown = objWorksheet.Range("A1:A" & objWorksheet.Cells(Rows.Count, "A").End(xlUp).Row)
'loop through all cells in range
For Each rngCell In rngBurnDown.Cells
objWorksheet.Select
' finds the word total with wildcard
If rngCell.Value Like "Total*" Then
'select the row
rngCell.EntireRow.Select
'copy the row
Selection.Copy
'new sheet to paste into
Set objNewSheet = ActiveWorkbook.Sheets("test")
objNewSheet.Select
'finding ghe next row
Set rngNextAvailbleRow = objNewSheet.Range("A1:A" & objNewSheet.Cells(Rows.Count, "A").End(xlUp).Row)
objNewSheet.Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select
ActiveSheet.Pastespecial xlpastevalues ' ---------error happens here
End If
Next rngCell
objWorksheet.Select
objWorksheet.Cells(1, 1).Select
Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub