VBA Excel-遍历工作表创建表

Question

Created this macro to go through the entire worksheet and format each section as a table with a specific format.

I'm trying to loop through the entire worksheet where and format each section as a table.

Each section is separated by one blank row.

Any ideas?

Sub Macro8()
Range("A3:B4").Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$3:$B$4"), , xlYes).Name = _
    "Table6"
Range("Table6[#All]").Select
ActiveSheet.ListObjects("Table6").TableStyle = "TableStyleLight9"

Selection.End(xlDown).Select
Selection.End(xlDown).Select
Range("A6:B7").Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$6:$B$7"), , xlYes).Name = _
    "Table7"
Range("Table7[#All]").Select
ActiveSheet.ListObjects("Table7").TableStyle = "TableStyleLight9"

Selection.End(xlDown).Select
Selection.End(xlDown).Select
Range("A9:D22").Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$9:$D$22"), , xlYes).Name = _
    "Table8"
Range("Table8[#All]").Select
ActiveSheet.ListObjects("Table8").TableStyle = "TableStyleLight9"

Selection.End(xlDown).Select
Selection.End(xlDown).Select
Range("A24:D37").Select
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$24:$D$37"), , xlYes).Name = _
    "Table9"
Range("Table9[#All]").Select
ActiveSheet.ListObjects("Table9").TableStyle = "TableStyleLight9"

End Sub

Answer 1

Give this a shot:

Sub MakeTables()

Dim ws As Worksheet
Set ws = Worksheets("Sheet1") 'change as needed

With ws

    'find last row of data in column A
    Dim lRow As Long
    lRow = .Range("A" & .Rows.Count).End(xlUp).Row

    Dim rngStart As Range
    Set rngStart = .Range("A3")

    'set counter variable for naming tables
    Dim i As Long
    i = i + 1

    Do

        'create table range
        Set rngTable = .Range(rngStart, rngStart.End(xlDown))

        'create table
        .ListObjects.Add(xlSrcRange, rngTable.Resize(rngTable.Rows.Count, rngStart.End(xlToRight).column), , xlYes).Name = "Table" & i
         'set style
        .ListObjects("Table" & i).TableStyle = "TableStyleLight9"

        'find next table range start
        Set rngStart = rngTable.End(xlDown).Offset(2)

        i = i + 1

    Loop Until rngStart.Row > lRow

End With

End Sub