Loop down vba Help

i need to add a loop down until blank to below vba. loop down list is in column a from cell A4 and each time is being copied into cell B1. any ideas ?


sub test1()
Range("A4").Select
Selection.CopySelect
Range("B1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

Call ThisWorkbook.ExcelRangeToPowerPoint

end sub

?

Code:

---

Sub vbax_53914_CopyFromColAToB1_CallAnotherSub_EachIteration()
    Dim i As Long
   
    With Worksheets("MySheet") 'Change MySheet to Suit
        For i = 4 To .Range("A" & .Rows.Count).End(xlUp).Row
            .Range("B1").Value = .Range("A" & i).Value
            ExcelRangeToPowerPoint
        Next i
    End With
End Sub

---

This works for this list however below the list I have formulad cells which returns blank value and it is copying the blanks to B1 rather than ending on the last in the list with a vlaue

add a condition:

Code:

---

Sub vbax_53914_CopyFromColAToB1_CallAnotherSub_EachIteration()
    Dim i As Long
   
    With Worksheets("MySheet") 'Change MySheet to Suit
        For i = 4 To .Range("A" & .Rows.Count).End(xlUp).Row
            If Len(.Range("A" & i).Value) > 0 Then
                .Range("B1").Value = .Range("A" & i).Value
                ExcelRangeToPowerPoint
            End If
        Next i
    End With
End Sub

---