在excel中遍历找出所要的字段的内容 （2）

遍历一个文件夹下的所有excel的所有sheet，找出所要的字段并整理到一个sheet页！

升级了！！

 

 

Sub データ込み22()
Dim strPath As String
Dim she As Worksheet

'文件的路径
strPath = "D:/業務/liwei/テーブルレイアウト_2090618/StockDB"

With Application.FileSearch
.LookIn = strPath
.SearchSubFolders = True
.Filename = ".xls"

If .Execute > 0 Then
For j = 1 To .FoundFiles.Count

Workbooks.Open Filename:=.FoundFiles(j)

Name = ActiveWorkbook.Name

For Each she In Worksheets

Workbooks("データ取り込みツール").Sheets("Sheet1").Activate
s_clm = ActiveSheet.UsedRange.Rows.Count
she.Activate

clm = 8
Do While Cells(clm, 3) <> ""
clm = clm + 1
Loop

    Range(Cells(8, 3), Cells(clm - 1, 3)).Copy
    Workbooks("数据").Sheets("Sheet1").Activate
    Cells(s_clm + 1, 4).Select
    ActiveSheet.Paste
    she.Activate
   
    Range(Cells(8, 2), Cells(clm - 1, 2)).Copy
    Workbooks("数据").Sheets("Sheet1").Activate
    Cells(s_clm + 1, 5).Select
    ActiveSheet.Paste
    she.Activate
   
    Range(Cells(8, 9), Cells(clm - 1, 9)).Copy
    Workbooks("数据").Sheets("Sheet1").Activate
    Cells(s_clm + 1, 6).Select
    ActiveSheet.Paste
    she.Activate
   

    n1 = Cells(4, 1)
    Workbooks("数据").Sheets("Sheet1").Activate
    e_clm = ActiveSheet.UsedRange.Rows.Count
    Range(Cells(s_clm + 1, 3), Cells(e_clm, 3)) = n1
    s_clm = ActiveSheet.UsedRange.Rows.Count
    Cells(s_clm + 1, 3) = "●"
Next she

Workbooks(Name).Close

Next j
End If
End With

End Sub