在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