在excel中遍歷找出所要的字段的內容

在一個excel文件中有100個sheet頁，每個sheet頁的格式固定，每個sheet頁有30列字段，上萬行的數據，如何把這個excel文件中的數據按需要的字段整理成一個sheet業中，如果手工作業的話是很煩人的，所以弄了個代碼幫忙，十幾秒搞定！！！

 

Sub readfield()
Dim she As Worksheet
Application.ScreenUpdating = False

 For Each she In Worksheets

 
   If she.Name <> "Sheet1" Then
'   And she.Tab.ColorIndex = 39
   Sheets("Sheet1").Activate   ------從sheet1開始讀取

   s_clm = ActiveSheet.UsedRange.Rows.Count
   she.Activate
  
   '開始執行的行
    clm = 9
    Do While Cells(clm, 3) <> ""
     clm = clm + 1
    Loop
   
   
 '複製字段1
    Range(Cells(9, 3), Cells(clm - 1, 3)).Copy
    Sheets("Sheet1").Activate
    Cells(s_clm + 1, 4).Select
    ActiveSheet.Paste
    she.Activate
   
  '複製字段2
    Range(Cells(9, 6), Cells(clm - 1, 6)).Copy
    Sheets("Sheet1").Activate
    Cells(s_clm + 1, 5).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    she.Activate
   
   '複製字段3
    Range(Cells(9, 14), Cells(clm - 1, 14)).Copy
    Sheets("Sheet1").Activate
    Cells(s_clm + 1, 6).Select
    ActiveSheet.Paste
   
    e_clm = ActiveSheet.UsedRange.Rows.Count
   
'
    Range(Cells(s_clm + 1, 3), Cells(e_clm, 3)) = Trim(she.Cells(7, 5))
   
    Cells(e_clm + 1, 3) = "●"
   
   
   
    End If
  
 Next she
 Application.ScreenUpdating = True
 
End Sub