Macros : to copy the number down

[Kazdima]

Hello,
I have 100 GL accounts and each GL has the same list of projects, as example- six projects.
I need to copy each GL account down for each project.
Can you help to write a Macro to automate this process?

<colgroup><col style="mso-width-source:userset;mso-width-alt:3876;width:80pt" width="106"> <col style="mso-width-source:userset;mso-width-alt:4608;width:95pt" width="126"> </colgroup><tbody>
[TD="class: xl75"]

<colgroup><col style="mso-width-source:userset;mso-width-alt:3876;width:80pt" width="106"> <col style="mso-width-source:userset;mso-width-alt:4608;width:95pt" width="126"> </colgroup><tbody>
[TD="class: xl76, width: 106"]Column A[/TD]
[TD="class: xl76, width: 126"]Column B[/TD]

[TD="class: xl77"]GL Account[/TD]
[TD="class: xl77"]Projects[/TD]

[TD="class: xl76"]100[/TD]
[TD="class: xl78"]Abc[/TD]

[TD="class: xl78"] [/TD]
[TD="class: xl78"]Bcd[/TD]

[TD="class: xl78"] [/TD]
[TD="class: xl78"]Cde[/TD]

[TD="class: xl78"] [/TD]
[TD="class: xl78"]Def[/TD]

[TD="class: xl78"] [/TD]
[TD="class: xl78"]Fgh[/TD]

[TD="class: xl78"] [/TD]
[TD="class: xl78"]Ghi[/TD]

[TD="class: xl76"]200[/TD]
[TD="class: xl78"]Abc[/TD]

[TD="class: xl78"] [/TD]
[TD="class: xl78"]Bcd[/TD]

[TD="class: xl78"] [/TD]
[TD="class: xl78"]Cde[/TD]

[TD="class: xl78"] [/TD]
[TD="class: xl78"]Def[/TD]

[TD="class: xl78"] [/TD]
[TD="class: xl78"]Fgh[/TD]

[TD="class: xl78"] [/TD]
[TD="class: xl78"]Ghi[/TD]

[TD="class: xl76"]300[/TD]
[TD="class: xl78"]Abc[/TD]

[TD="class: xl78"] [/TD]
[TD="class: xl78"]Bcd[/TD]

[TD="class: xl78"] [/TD]
[TD="class: xl78"]Cde[/TD]

[TD="class: xl78"] [/TD]
[TD="class: xl78"]Def[/TD]

[TD="class: xl78"] [/TD]
[TD="class: xl78"]Fgh[/TD]

[TD="class: xl78"] [/TD]
[TD="class: xl78"]Ghi[/TD]

[TD="class: xl76"]400[/TD]
[TD="class: xl78"]Abc[/TD]

[TD="class: xl78"] [/TD]
[TD="class: xl78"]Bcd[/TD]

[TD="class: xl78"] [/TD]
[TD="class: xl78"]Cde[/TD]

[TD="class: xl78"] [/TD]
[TD="class: xl78"]Def[/TD]

[TD="class: xl78"] [/TD]
[TD="class: xl78"]Fgh[/TD]

[TD="class: xl78"] [/TD]
[TD="class: xl78"]Ghi[/TD]

</tbody>

[/TD]

[TD="class: xl76"][/TD]

[TD="class: xl76"][/TD]
[TD="class: xl76"][/TD]

[TD="class: xl76"][/TD]
[TD="class: xl76"][/TD]

[TD="class: xl76"][/TD]
[TD="class: xl76"]Thank you
[/TD]

[TD="class: xl76"][/TD]
[TD="class: xl76"][/TD]

[TD="class: xl76"][/TD]
[TD="class: xl76"][/TD]

[TD="class: xl76"][/TD]

[TD="class: xl76"][/TD]

[TD="class: xl76"][/TD]

[TD="class: xl76"][/TD]
[TD="class: xl76"][/TD]

[TD="class: xl76"][/TD]
[TD="class: xl76"][/TD]

[TD="class: xl76"][/TD]

[TD="class: xl76"][/TD]

[TD="class: xl76"][/TD]

[TD="class: xl76"] [/TD]
[TD="class: xl76"][/TD]

[TD="class: xl77, align: right"][/TD]
[TD="class: xl76"][/TD]

[TD="class: xl76"][/TD]
[TD="class: xl76"][/TD]

[TD="class: xl76"][/TD]
[TD="class: xl76"][/TD]

[TD="class: xl76"][/TD]
[TD="class: xl76"][/TD]

[TD="class: xl76"][/TD]
[TD="class: xl76"][/TD]

[TD="class: xl76"][/TD]
[TD="class: xl76"][/TD]

</tbody>

 

[MARK858]

If your table is literally as you posted try....

Sub FillCell1()
    Dim fCell As Range
    On Error Resume Next

    For Each fCell In Range("A2:A" & Range("B" & Rows.Count).End(xlUp).Row). _
        SpecialCells(xlCellTypeBlanks).Areas
        fCell.Value = fCell(1).Offset(-1).Value
    Next

    On Error GoTo 0
End Sub

I am assuming that Column A and Column B aren't part of the table.

 

[lrobbo314]

Another way as a 1 liner.

Sub FillDown()
Range("A2:A" & Range("B" & Rows.Count).End(xlUp).Row).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C+1"
End Sub

Same assumptions that MARK858 stated.

 

[Osvaldo Palmeiro]

Try:

Sub ReplicateGLAcc()
 Dim a As Long
  For a = 2 To Cells(Rows.Count, 1).End(3).Row Step 6
   Cells(a, 1).Resize(6).FillDown
  Next a
End Sub

 

[MARK858]

Or yet another couple of options....

Sub FillDwn()

    Dim Ar As Areas
    Dim a As Range

    Set Ar = Range("A2:A" & Range("B" & Rows.Count).End(xlUp).Row).SpecialCells(xlBlanks).Areas
    For Each a In Ar
        a.Offset(-1).Resize(a.Rows.Count + 1).FillDown
    Next a

End Sub

Sub FillIt3()
  With Range("A2:A" & Range("B" & Rows.Count).End(xlUp).Row)
    .SpecialCells(xlBlanks).FormulaR1C1 = "=R[-1]C"
    .Value = .Value
  End With
End Sub

 

[Kazdima]

HI Mark858,
your VBA is working perfect-)
Thank you very much,
Dan

 

[Kazdima]

HI Irobbo314,
You VBA creates sequential number population.
Sorry, that is not what I was looking for.
Mark858' s is working OK.
Thank you,
Dan

 

[Kazdima]

Hi Osvaldo, yours VBA is not working..

Do not worry, Mark 858 solved the problem.
Thank you,
Dan

 

[Kazdima]

Hi Mark858,

all yours three VBAs are working perfectly-)
You are great!
Thank you,
Dan

 

[MARK858]

Hi Osvaldo, yours VBA is not working..

Do not worry, Mark 858 solved the problem.
Thank you,
Dan

You are welcome but I must state that if your actual data is exactly the same layout as post 1 then Osvaldo's code works fine for me.