Data copy from 1 sheet to another

jaikin · 07-28-2009, 08:44 AM

I'm working on a score sheet to allow supervisors to monitor and score calls for quality assurance in a contact center.

Currently, I have a sheet in my workbook called "observation" which is the sheet supervisors will use to grade the call.

At the end of the sheet I have a button designed to copy the data from the observation sheet to "sheet1" which is where we will store the scores for reporting.

It all works well, except that several of my cells are giving Div/0 errors after the copy.

It looks like the script is copying the formula instead of the values.

Here is my current code:

Code:

Private Sub CommandButton1_Click()

Dim ShA As Worksheet
Dim ShB As Worksheet
Dim TargetRange1 As Range
Dim TargetRange2 As Range
Dim TargetRange3 As Range
Dim TargetRange4 As Range
Dim TargetRange5 As Range
Dim TargetRange6 As Range
Dim TargetRange7 As Range
Dim TargetRange8 As Range
Dim TargetRange9 As Range
Dim TargetRange10 As Range
Dim TargetRange11 As Range
Dim TargetRange12 As Range
Dim TargetRange13 As Range
Dim TargetRange14 As Range
Dim TargetRange15 As Range
Dim TargetRange16 As Range
Dim TargetRange17 As Range
Dim TargetRange18 As Range
Dim TargetRange19 As Range
Dim TargetRange20 As Range
Dim TargetRange21 As Range
Dim TargetRange22 As Range
Dim TargetRange23 As Range
Dim CopyToCell As Range


Set ShA = Worksheets("Observation")
Set ShB = Worksheets("Sheet1")
With ShA
    Set TargetRange1 = .Range("C5:C11,C19:C25")
    Set TargetRange2 = .Range("D18:F18")
    Set TargetRange5 = .Range("C27:C34")
    Set TargetRange6 = .Range("D26:F26")
    Set TargetRange9 = .Range("C36:C44")
    Set TargetRange10 = .Range("D35:F35")
    Set TargetRange13 = .Range("C46:C49")
    Set TargetRange14 = .Range("D45:F45")
    Set TargetRange17 = .Range("C51:C52")
    Set TargetRange18 = .Range("D50:F50")
    Set TargetRange21 = .Range("C53, E53:F53")
End With


If ShB.Range("A2") = "" Then ' Headings in row 1
    Set CopyToCell = ShB.Range("A2")
Else
    Set CopyToCell = ShB.Range("A1").End(xlDown).Offset(1, 0)
End If


TargetRange1.Copy
CopyToCell.PasteSpecial xlPasteValues, , , Transpose:=True
TargetRange2.Copy Destination:=CopyToCell.Offset(0, 14)
TargetRange5.Copy
CopyToCell.Offset(0, 17).PasteSpecial xlPasteValues, , , Transpose:=True
TargetRange6.Copy Destination:=CopyToCell.Offset(0, 25)
TargetRange9.Copy
CopyToCell.Offset(0, 28).PasteSpecial xlPasteValues, , , Transpose:=True
TargetRange10.Copy CopyToCell.Offset(0, 37)
TargetRange13.Copy
CopyToCell.Offset(0, 40).PasteSpecial xlPasteValues, , , Transpose:=True
TargetRange14.Copy CopyToCell.Offset(0, 44)
TargetRange17.Copy
CopyToCell.Offset(0, 47).PasteSpecial xlPasteValues, , , Transpose:=True
TargetRange18.Copy CopyToCell.Offset(0, 49)
TargetRange21.Copy
CopyToCell.Offset(0, 52).PasteSpecial xlPasteValues
Application.CutCopyMode = False



End Sub

I thought that the PasteSpecial xlPasteValues would resolve this, but I seem to be missing something.

the cells in question are:
D18, E18, F18
D26, E26, F26
D35, E35, F35
D45, E45, F45
D50, E50, F50

Basically the fields that report overall scores from formulas.

Can someone point me in the right direction?

Thanks.