Autofill every n rows - excel

Question

How can I autofill the entirety of column B based on column A but with n empty rows in between each letter?
Column A:
a
b
c
Column B:
a
...
...
b
...
...
c
I have tried the VBA code below:
Range("A1:A3").AutoFill Destination:=Range("A1:A10"), Type:=xlFillDefault
The code works with numbers but not when the cell references a formula (in this case, =A1, ...) as the code seems to reference the row the formula is, instead of the list in column A.
For example, the code inserts the formula a row after c in B7, however would insert =A7 instead of =A4 which would be the letter d.
Any help with this would be greatly appreciated.

Answer 1

To insert n row for each value in Column A, I will use offset to solve it, here is the solution and hope you find it useful:
Sub ty()
Dim count As Long, i As Long, nextrow As Long
count = Application.WorksheetFunction.CountA(Sheet1.Range("A:A"))
nextrow = 1
For i = 1 To count
Sheet1.Cells(nextrow, 2).Value = Sheet1.Cells(i, 1).Value
nextrow = Cells(nextrow, 2).Offset(3, 1).Row
Next
End Sub
Expected Output:
In order to preserve the formula into new cells, then you may need copy method` by change this part:
For i = 1 To count
Sheet1.Cells(i, 1).Copy Sheet1.Cells(nextrow, 2)
nextrow = nextrow + 3
Next

Answer 2

AutoFill Every n Rows
You run GetGappedColumnTEST. GetGappedColumn is being called by the GetGappedColumnTEST.
Adjust the values in the constants section and the workbook, and rename the Sub appropriately.
Option Explicit
Sub GetGappedColumnTEST()
Const sName As String = "Sheet1"
Const sFirst As String = "A1"
Const dName As String = "Sheet1"
Const dFirst As String = "B1"
Const dGap As Long = 2
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim Data As Variant
Data = GetGappedColumn(wb.Worksheets(sName).Range(sFirst), dGap)
If IsEmpty(Data) Then Exit Sub
Dim drCount As Long: drCount = UBound(Data, 1)
With wb.Worksheets(dName).Range(dFirst)
.Resize(drCount).Value = Data
.Resize(.Worksheet.Rows.Count - .Row - drCount + 1) _
.Offset(drCount).ClearContents
End With
End Sub
Function GetGappedColumn( _
ByVal FirstCell As Range, _
Optional ByVal Gap As Long = 0) _
As Variant
Const ProcName As String = "GetGappedColumn"
On Error GoTo clearError
If FirstCell Is Nothing Then Exit Function
If Gap < 0 Then Exit Function
Dim srg As Range
With FirstCell.Cells(1)
Dim lCell As Range
Set lCell = .Resize(.Worksheet.Rows.Count - .Row + 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If lCell Is Nothing Then Exit Function
Set srg = .Resize(lCell.Row - .Row + 1)
End With
Dim rCount As Long: rCount = srg.Rows.Count
Dim sData As Variant
If rCount = 1 Then
ReDim sData(1 To 1, 1 To 1): sData(1, 1) = srg.Value
Else
sData = srg.Value
End If
Dim dData As Variant: ReDim dData(1 To rCount + rCount * Gap - Gap, 1 To 1)
Dim d As Long: d = 1
Dim s As Long
For s = 1 To rCount - 1
dData(d, 1) = sData(s, 1)
d = d + 1 + Gap
Next s
dData(d, 1) = sData(s, 1)
GetGappedColumn = dData
ProcExit:
Exit Function
clearError:
Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
& " " & "Run-time error '" & Err.Number & "':" & vbLf _
& " " & Err.Description
Resume ProcExit
End Function