Saving data to a second sheet

I'm working on a quality scorecard for a contact center in excel


The sheet works fine right now to score calls, etc., but the next step
is to save the data somewhere.

So, I'm trying to save the data into rows on another sheet.

In more detail, what I'm hoping to do is add a "save" button to the
bottom of the scoring sheet that does the following:

Copies (for example) cells c1, c2, c3, c4, c5, d7, e7 and e11 to a
second sheet and puts that data in rows so that row 1 would look like
this:
Cell A1 contains the data from sheet1, cell c1.
Cell B1 contains the data from seeht 1 cell c2
and so on.

Here is what I did:

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") 
Set TargetRange3 = .Range("E18") 
Set TargetRange4 = .Range("F18") 
Set TargetRange5 = .Range("C27:C34") 
Set TargetRange6 = .Range("D26") 
Set TargetRange7 = .Range("E26") 
Set TargetRange8 = .Range("F26") 
Set TargetRange9 = .Range("C36:C44") 
Set TargetRange10 = .Range("D35") 
Set TargetRange11 = .Range("E35") 
Set TargetRange12 = .Range("F35") 
Set TargetRange13 = .Range("C46:C49") 
Set TargetRange14 = .Range("D45") 
Set TargetRange15 = .Range("E45") 
Set TargetRange16 = .Range("F45") 
Set TargetRange17 = .Range("C51:C52") 
Set TargetRange18 = .Range("D50") 
Set TargetRange19 = .Range("E50") 
Set TargetRange20 = .Range("F50") 
Set TargetRange21 = .Range("C53") 
Set TargetRange22 = .Range("E53") 
Set TargetRange23 = .Range("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 
TargetRange3.Copy 
TargetRange4.Copy 
TargetRange5.Copy 
TargetRange6.Copy 
TargetRange7.Copy 
TargetRange8.Copy 
TargetRange9.Copy 
TargetRange10.Copy 
TargetRange11.Copy 
TargetRange12.Copy 
TargetRange13.Copy 
TargetRange14.Copy 
TargetRange15.Copy 
TargetRange16.Copy 
TargetRange17.Copy 
TargetRange18.Copy 
TargetRange19.Copy 
TargetRange20.Copy 
TargetRange21.Copy 
TargetRange22.Copy 
TargetRange23.Copy 
CopyToCell.Offset(0, 55).PasteSpecial xlPasteValues, , , 
Transpose:=True 
Application.CutCopyMode = False 

End Sub

What happens with my version is that range 1 copies perfectly, but the
rest do not.


Can anyone point me in the right direction please?
Thank you.

Hello jakin,

Welcome to the Forum!

Here is shorter version of your code. You can change the sheet names in the code if you need to. They are marked in red.

Sub CopyToRow()

  Dim C As Long
  Dim Cell As Range
  Dim DstRng As Range
  Dim SrcRng As Range
  
    Set DstRng = Worksheets("Sheet2").Range("A1")
    Set SrcRng = Wowrksheets("Sheet1").Range("C1:C5,D7, E7, E11")
    
      For Each Cell In SrcRng
        Cell.Copy DstRng.Offset(0, C)
        C = C + 1
        If C > Columns.Colunt Then Exit Sub
      Next Cell
    
End Sub