Loop paste cels with formula

[Marlowwe]

Hey guys,

i would like to ask you for help. Icreating macro to copy cell (with formula) to right cell (it will be variable- 3 or 4 cells etc.) from multiple selection.

And also should be variable how many times it will be copied

	A	B	C	D	E	F	G	H	I
1	=SUM(A2:A3 )
2	1
3	2
4
5	=SUM(A6:A7 )
6	3
7	4

<tbody>
</tbody>

After macro should be like this:
Variables:

• 2x copy to right
• offset 2

	A	B	C	D	E	F	G	H	I
1	=SUM(A2:A3 )		=SUM(C2:C3)		=SUM(E2:E3)
2	1
3	2
4
5	=SUM(A6:A7 )		=SUM(C6:C7)		=SUM(E6:E7)
6	3
7	4

<tbody>
</tbody>

My try is this, but it doesnt work. it copy only once and with the exact formula from original cell.

Sub Formula_multiCopy()
Dim rng As Range


' The looping routine
Set rng = Selection
Do Until IsEmpty(rng)
    rng.Offset(, 2) = rng.Formula
        
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
Loop
End Sub

Thank you for your help

 

[Fluff]

Are the values in A2:A3 & A6:A7 hard values, or are they formulae?

 

[Marlowwe]

Hard numbers are in that ranges A2:A3 & A6:A7 (it could be A2:A256 etc.)

It makes difference if in that selection is Formula ?

Basicly: Select one or several Cells with Function Sum -> Copy -> paste cell according Variables x times to left with x offset.

Are the values in A2:A3 & A6:A7 hard values, or are they formulae?

 

[Fluff]

As they are not formulae try this

Sub CopyFormula()

   Dim Cnt As Long
   
   With Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlFormulas)
      For Cnt = [COLOR=#ff0000]2 To 4 Step 2[/COLOR]
         .Offset(, Cnt).Formula = .FormulaR1C1
      Next Cnt
   End With

End Sub

It will copy your formulae to cols C & E.
You can change the part in red to suit.
The first 2 specifies col C
The 4 is the last column you want the formula to copy to.
The last 2 specifies how many columns to skip.

 

[Marlowwe]

Wow, it works perfectly.

Could you help me with this small modification ?

Sub CopyFormula_imput()
   Dim myOffset As String
   Dim myNumber As String
   Dim Cnt As Long
   
 [COLOR=#ff0000]  myOfft = InputBox("How many cels will be offset: ", "GleedsTool", "2")
   myNumb = InputBox("How many copies: ", "GleedsTool", "1")[/COLOR]
   
   
   With Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlFormulas)
      For Cnt = [COLOR=#ff0000]myOff[/COLOR] To [COLOR=#ff0000]myNumb * 2[/COLOR] Step [COLOR=#ff0000]myOff[/COLOR]
         .Offset(, Cnt).Formula = .FormulaR1C1
      Next Cnt
   End With


End Sub

Something is missing in my modification, but I dont know what.

Thanks

As they are not formulae try this

Sub CopyFormula()

   Dim Cnt As Long
   
   With Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlFormulas)
      For Cnt = [COLOR=#ff0000]2 To 4 Step 2[/COLOR]
         .Offset(, Cnt).Formula = .FormulaR1C1
      Next Cnt
   End With

End Sub

It will copy your formulae to cols C & E.
You can change the part in red to suit.
The first 2 specifies col C
The 4 is the last column you want the formula to copy to.
The last 2 specifies how many columns to skip.

 

[Fluff]

Try

Sub CopyFormula_input()
   Dim myOfft As Long
   Dim myNumb As Long
   Dim Cnt As Long
   
   myOfft = InputBox("How many cels will be offset: ", "GleedsTool", "2")
   myNumb = InputBox("How many copies: ", "GleedsTool", "1")
   
   
   With Range("A1", Range("A" & Rows.Count).End(xlUp)).SpecialCells(xlFormulas)
      For Cnt = myOfft To myNumb * myOfft Step myOfft
         .Offset(, Cnt).Formula = .FormulaR1C1
      Next Cnt
   End With


End Sub

 

[Marlowwe]

Thnak you, its working perfectly. It works only when I copy macro only to workbook module. When I put macro to PERSONAL.XLSB and the error is there:

Sub CopyFormula_input()
   Dim myOfft As Long
   Dim myNumb As Long
   Dim Cnt As Long
   
   myOfft = InputBox("How many cels will be offset: ", "GleedsTool", "2")
   myNumb = InputBox("How many copies: ", "GleedsTool", "1")
   
   
   With Range("A1", Range("A" & Rows[COLOR=#ff0000].Count[/COLOR]).End(xlUp)).SpecialCells(xlFormulas)
      For Cnt = myOfft To myNumb * myOfft Step myOfft
         .Offset(, Cnt).Formula = .FormulaR1C1
      Next Cnt
   End With

End Sub

Try

Sub CopyFormula_input()
   Dim myOfft As Long
   Dim myNumb As Long
   Dim Cnt As Long
.............

 

[Fluff]

What error message do you get?

 

[Marlowwe]

What error message do you get?

 

[Fluff]

Not sure why you would get that & cannot replicate it here.
Could you check all the code in your Personal.xlsb & see if you have declared either Rows or Count as a variable.