Move and Link2

[TGalin]

My apologies I posted the same question earlier but I just realized that I
didn’t make my question very clear. I am trying to repeat the code below so
that it covers every cell in the range A4:A200 as well as AK4:AK200
In Sheet 1 copy range A4:H4. In Sheet 2 paste A4:H4 into cell B5. Next link
cell B4 in Sheet 2 to cell AK4 in Sheet1. Afterwards return to Sheet 1 copy
range A5:H5. In Sheet 2 paste A5:H5 into cell B7. Next link cell B6 in
Sheet 2 to cell AK5 in Sheet1. Repeat the pattern until every cell in range
A4:H200 has been covered. Here is what I have so far.

Sub Moveandlink()
Application.Goto Reference:="R4C1:R4C8"
Selection.Copy
Sheets("Sheet 2").Select
Range("B5").Select
ActiveSheet.Paste
Range("B4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "='Sheet 1'!RC[35]"
Range("B5").Select
Sheets("Sheet 1").Select
Application.Goto Reference:="R5C1:R5C8"
Selection.Copy
Sheets("Sheet 2").Select
Range("B7").Select
ActiveSheet.Paste
Range("B6").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "='Sheet 1'!R[-1]C[35]"
Range("B7").Select
End Sub

 

[Peter T]

A bit confusing because your code does not appear to do quite what you
describe, so you may need to adapt the following:

Sub abc()
Dim rw As Long
Dim rngSource As Range
Dim rngDest As Range
Dim rng As Range

Set rngSource = Worksheets("Sheet 1").Range("A4:H200")
Set rngDest = Worksheets("Sheet 2").Range("B4")

With rngSource
Set rngDest = rngDest.Resize(.Rows.Count * 2, .Columns.Count)
End With

For Each rng In rngSource.Rows
rw = rw + 2
rngDest.Rows(rw).Value = rng.Value
Next

Set rngSource = Worksheets("Sheet 1").Range("Ak4:AK200")
rw = -1
For Each rng In rngSource
rw = rw + 2
rngDest(rw, 1).Formula = "=" & rng.Address(external:=True)
Next

End Sub

Regards,
Peter T

 

[TGalin]

Thanks for the tip. I am kind of new at this so I could understand why this
would come across as confusing. I think some of the blur might have been
caused because I used the go to cell command instead of just clicking on the
cell I wanted. Whatever the case, this does exactly what I was trying to do
and very well I might add. Thank you for you're help!

A bit confusing because your code does not appear to do quite what you
describe, so you may need to adapt the following:

Sub abc()
Dim rw As Long
Dim rngSource As Range
Dim rngDest As Range
Dim rng As Range

Set rngSource = Worksheets("Sheet 1").Range("A4:H200")
Set rngDest = Worksheets("Sheet 2").Range("B4")

With rngSource
Set rngDest = rngDest.Resize(.Rows.Count * 2, .Columns.Count)
End With

For Each rng In rngSource.Rows
rw = rw + 2
rngDest.Rows(rw).Value = rng.Value
Next

Set rngSource = Worksheets("Sheet 1").Range("Ak4:AK200")
rw = -1
For Each rng In rngSource
rw = rw + 2
rngDest(rw, 1).Formula = "=" & rng.Address(external:=True)
Next

End Sub

Regards,
Peter T

My apologies I posted the same question earlier but I just realized that I
didn't make my question very clear. I am trying to repeat the code below
so
that it covers every cell in the range A4:A200 as well as AK4:AK200
In Sheet 1 copy range A4:H4. In Sheet 2 paste A4:H4 into cell B5. Next
link
cell B4 in Sheet 2 to cell AK4 in Sheet1. Afterwards return to Sheet 1
copy
range A5:H5. In Sheet 2 paste A5:H5 into cell B7. Next link cell B6 in
Sheet 2 to cell AK5 in Sheet1. Repeat the pattern until every cell in
range
A4:H200 has been covered. Here is what I have so far.

Sub Moveandlink()
Application.Goto Reference:="R4C1:R4C8"
Selection.Copy
Sheets("Sheet 2").Select
Range("B5").Select
ActiveSheet.Paste
Range("B4").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "='Sheet 1'!RC[35]"
Range("B5").Select
Sheets("Sheet 1").Select
Application.Goto Reference:="R5C1:R5C8"
Selection.Copy
Sheets("Sheet 2").Select
Range("B7").Select
ActiveSheet.Paste
Range("B6").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "='Sheet 1'!R[-1]C[35]"
Range("B7").Select
End Sub