Snasui Excel Forum

Code: Select all

Option Explicit
Sub a()
Call Entry("A")
End Sub
Sub b()
Call Entry("B")
End Sub
Sub Entry(ByVal v As String)
Dim ar() As String
Dim r As Range
Dim i, lr As Integer
i = 1
lr = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row

Set r = Range("B2:B" & lr)
        For Each r In r
                ReDim Preserve ar(i) As String
                ar(i) = r.Value
                i = i + 1
        Next r

         For i = 1 To UBound(ar) + 1
                 Cells(i + 1, 2).Value = ar(i - 1)
         Next i
         Cells(2, 2).Value = v & lr + 1
End Sub

Code: Select all

Sub Entry(ByVal v As String)
Dim ar() As String
Dim r As Range
Dim i, lr As Integer
i = 1
lr = ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row

Set r = Range("B2:B" & lr)
        For Each r In r
                ReDim Preserve ar(i) As String
                ar(i) = r.Value
                i = i + 1
        Next r
'
         For i = 1 To UBound(ar) + 1
                 'Cells(i + 1, 2).Value = ar(i - 1)
         Next i
         Cells(lr + 1, 2).Value = v & lr
End Sub