Thanks for your reply.
You have to add a destination for each copy statement.
Where target range is a column, it has to be transposed using PasteSpecal,
though if target range is a row, we don't need a paste or paste special
statement, but can state the destination after the copy statement (same
line) with or without using "Destination:="
Try this:
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
Regards,
Per
"the Swing" <
[email protected]> skrev i meddelelsen
Thank you Per - you rock.
I hope you will be patient for just a bit longer, your code worked
great, but I obviously did something wrong when I tried to expand it.
Here is the code I'm trying to use:
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
It turned out that clearing the sheet also removed the formulas, so I
took those lines out of yoru code, and then started adding all of the
cells I actually need to copy.
What happens with my version is that range 1 copies perfectly, but the
rest do not.
Can you point me in the right direction please?
Thank you.