遍历子文件夹，横向填充表格

Sub ABC()

Dim Sph

Sph = Dir("D:\data\*" & Cells(1, 1) & "*", 16)

If Sph = "" Then Exit Sub

Sph = "D:\data\" & Sph & "\"

Dir Sph, 16

Dir

Do

co = co + 1

sph1 = Dir()

If sph1 = "" Then Exit Do

Cells(2, co) = sph1

ActiveSheet.Hyperlinks.Add Cells(2, co), Sph & sph1

Loop

For i = 1 To co - 1

If Dir(Sph & Cells(2, i) & "\*") <> "" Then

ro = 3

Do

fi = Dir()

If fi = "" Then Exit Do

Cells(ro, i) = fi

ActiveSheet.Hyperlinks.Add Cells(ro, i), Sph & Cells(2, i) & "\" & fi

ro = ro + 1

Loop

End If

Next

End Sub