Do Until Loop For Each Next

'セル内容取得
Dim i As Long

    With Worksheets(ActiveSheet.Name)

        i = 1

        Do Until .Cells(i, 1).Value = ""

            .Cells(i, 2).Value = i

            i = i + 1

        Loop

    End With

'シート確認

Dim ws As Worksheet

    For Each ws In Worksheets

        MsgBox ws.Name

    Next ws

MaxRow = Range("A1").End(xlDown).Row 

MaxCol = Range("A1").End(xlToRight).Column 

'CSV 出力

Sub csvOut()

    Dim ranRc As Range

    Dim ranCr As Range

    Dim i As Integer

    Dim j As Integer

    Dim strFileName As String

    strFileName = "C:\Users\ak\Desktop\sss.csv" 'Application.GetSaveAsFilename()

    Open strFileName For Output Access Write As #1

    Set ranCr = Cells(1, 1).CurrentRegion

    j = ranCr.Columns.Count - 1

    For Each ranRc In ranCr.Rows

        For i = 1 To j

            Write #1, ranRc.Columns(i).Value;

        Next i

        Write #1, ranRc.Columns(i).Value

    Next

    Set ranCr = Nothing

    Close #1

    MsgBox "END"


参考　行列取得