Automating row offset

[itisananas]

Hey all!

SO far i tried this vba code and it works, but the cons is that it only works for 12 rows and
i want is to make like it works for a bigger amount of rows.
I am kinda new to this things and just trying to figure it out.

What it does is its reads cell value in J5 and if that value is the same as the given value then in uses the given macro.
That macro always copies the value in cell B5 and paste it in the given cell G5,G6,G7 and so on.

J5 btw is a sum of the already excisting values in the column.

So what im trying to achief is the part where i can given i variable(i think) where it can automated the row part, that it goes on like +1,+1,+1

The VBA code i am using currently:

Sub Vergelijking()

    If Range("J5").Value = 1 Then
    Macro1
   
    ElseIf Range("j5").Value = 2 Then
    Macro2
   
    ElseIf Range("J5").Value = 3 Then
    Macro3
   
    ElseIf Range("J5").Value = 4 Then
    Macro4
   
    ElseIf Range("J5").Value = 5 Then
    Macro5
   
    ElseIf Range("J5").Value = 6 Then
    Macro6
   
    ElseIf Range("J5").Value = 7 Then
    Macro7
   
    ElseIf Range("J5").Value = 8 Then
    Macro8
   
    ElseIf Range("J5").Value = 9 Then
    Macro9
   
    ElseIf Range("J5").Value = 10 Then
    Macro10
   
    ElseIf Range("J5").Value = 11 Then
    Macro11
   
    ElseIf Range("J5").Value = 12 Then
    Macro12
           
    End If
   
   
End Sub

Sub Macro1()
'
' Macro1 Macro
'

'
    Range("B5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("G5").Select
    ActiveSheet.Paste
    Range("B5").Select
    Selection.ClearContents
End Sub
Sub Macro2()
'
' Macro2 Macro
'

'
    Range("B5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("G6").Select
    ActiveSheet.Paste
    Range("B5").Select
    Selection.ClearContents
End Sub
Sub Macro3()
'
' Macro3 Macro
'

'
    Range("B5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("G7").Select
    ActiveSheet.Paste
    Range("B5").Select
    Selection.ClearContents
End Sub
Sub Macro4()
'
' Macro4 Macro
'

'
    Range("B5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("G8").Select
    ActiveSheet.Paste
    Range("B5").Select
    Selection.ClearContents
End Sub
Sub Macro5()
'
' Macro5 Macro
'

'
    Range("B5").Select
    Selection.Copy
    Range("G9").Select
    ActiveSheet.Paste
    Range("B5").Select
    Application.CutCopyMode = False
    Selection.ClearContents
End Sub
Sub Macro6()
'
' Macro6 Macro
'

'
    Range("B5").Select
    Selection.Copy
    Range("G10").Select
    ActiveSheet.Paste
    Range("B5").Select
    Application.CutCopyMode = False
    Selection.ClearContents
End Sub
Sub Macro7()
'
' Macro7 Macro
'

'
    Range("B5").Select
    Selection.Copy
    Range("G11").Select
    ActiveSheet.Paste
    Range("B5").Select
    Application.CutCopyMode = False
    Selection.ClearContents
End Sub
Sub Macro8()
'
' Macro8 Macro
'

'
    Range("B5").Select
    Selection.Copy
    Range("G12").Select
    ActiveSheet.Paste
    Range("B5").Select
    Application.CutCopyMode = False
    Selection.ClearContents
End Sub
Sub Macro9()
'
' Macro9 Macro
'

'
    Range("B5").Select
    Selection.Copy
    Range("G13").Select
    ActiveSheet.Paste
    Range("B5").Select
    Application.CutCopyMode = False
    Selection.ClearContents
End Sub
Sub Macro10()
'
' Macro10 Macro
'

'
    Range("B5").Select
    Selection.Copy
    Range("G14").Select
    ActiveSheet.Paste
    Range("B5").Select
    Application.CutCopyMode = False
    Selection.ClearContents
End Sub
Sub Macro11()
'
' Macro11 Macro
'

'
    Range("B5").Select
    Selection.Copy
    Range("G15").Select
    ActiveSheet.Paste
    Range("B5").Select
    Application.CutCopyMode = False
    Selection.ClearContents
End Sub
Sub Macro12()
'
' Macro12 Macro
'

'
    Range("B5").Select
    Selection.Copy
    Range("G16").Select
    ActiveSheet.Paste
    Range("B5").Select
    Application.CutCopyMode = False
    Selection.ClearContents
End Sub

 

[Fluff]

How about

Sub itisananas()
   With Range("J5")
      If .Value > 0 Then
         Range("B5").Copy Range("G" & .Value + 4)
         Range("B5").ClearContents
      End If
   End With
End Sub

 

[itisananas]

Hey FLuff,

Thankyou so much it works! :D

 

[itisananas]

How about

Sub itisananas()
   With Range("J5")
      If .Value > 0 Then
         Range("B5").Copy Range("G" & .Value + 4)
         Range("B5").ClearContents
      End If
   End With
End Sub

Hey FLuff,

Thank you so much it works! :D

 

[Fluff]

You're welcome & thanks for the feedback.

 

[itisananas]

How about

Sub itisananas()
   With Range("J5")
      If .Value > 0 Then
         Range("B5").Copy Range("G" & .Value + 4)
         Range("B5").ClearContents
      End If
   End With
End Sub

Uhm i got a extra question, what needs to be changed when i want this to apply on 2 different sheets? Lets say B5 is on Sheet 1 and the past and J5 value are on sheet 2?
I dont know if i need to make a new thread out of this, but if so then i will

 

[Fluff]

How about

Sub itisananas()
   With Sheets("Sheet2").Range("J5")
      If .Value > 0 Then
         Sheets("Sheet1").Range("B5").Copy Sheets("Sheet2").Range("G" & .Value + 4)
         Sheets("Sheet1").Range("B5").ClearContents
      End If
   End With
End Sub

 

[itisananas]

How about

Sub itisananas()
   With Sheets("Sheet2").Range("J5")
      If .Value > 0 Then
         Sheets("Sheet1").Range("B5").Copy Sheets("Sheet2").Range("G" & .Value + 4)
         Sheets("Sheet1").Range("B5").ClearContents
      End If
   End With
End Sub

Okey i tried it oud but it seems it doesnt count anymore. I changed the sheet names, since my Excel is in Dutch and changed the copy paste cells.

Sub itisananas()
   With Sheets("Blad6").Range("D2")
      If .Value > 0 Then
         Sheets("Blad5").Range("D3").Copy Sheets("Blad6").Range("E" & .Value + 4)
         Sheets("Blad5").Range("D3").ClearContents
       End If
   End With
End Sub

 

[Fluff]

What do you mean "it doesn't count" ?

 

[itisananas]

What do you mean "it doesn't count" ?

Sorry i forgot to add a +1 somewhere but it works now. Thankyou so much again! :D