![]() |
Move and Link2
My apologies I posted the same question earlier but I just realized that I
didnt 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 |
Move and Link2
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" wrote in message ... 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 |
Move and Link2
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! "Peter T" wrote: 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" wrote in message ... 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 |
All times are GMT +1. The time now is 05:18 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com