compile, copy, pastespecial

[josephgunter163]

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?

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

 

[MARK858]

Before we start asking the usual questions about sheet protection, merged cells, what rngNextAvailbleRow is when the error occurs etc. what happens if you change

    objNewSheet.Range("A" & rngNextAvailbleRow.Rows.Count + 1).Select
 
     ActiveSheet.Pastespecial xlpastevalues

to

objNewSheet.Range("A" & rngNextAvailbleRow.Rows.Count + 1).PasteSpecial xlPasteValues

 

[josephgunter163]

Mark! you are great. that simple change made the differance and the code works juat as it should. For referance sheet is not protected and cells are not merged. here is the working code

Private Sub CommandButton7_Click() 'inserts new sheet and moves data to that sheet from another sheet based on criteria
    
Dim objWorksheet As Worksheet
Dim rngBurnDown As Range
Dim rngCell As Range
Dim strPasteToSheet As String
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 the next row
    Set rngNextAvailbleRow = objNewSheet.Range("A1:A" & objNewSheet.Cells(Rows.Count, "A").End(xlUp).Row)

    objNewSheet.Range("A" & rngNextAvailbleRow.Rows.Count + 1).PasteSpecial xlPasteValues

 
    End If
Next rngCell
objWorksheet.Select
objWorksheet.Cells(1, 1).Select
    Application.DisplayAlerts = True
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub