返回列表 上一主題 發帖

如何搜尋多個sheet的資料貼到第一個sheet內?

Hsieh

帖子
4901 
主題
44 
精華
24 
積分
4916 
點名
142  
作業系統
Windows 7 
軟體版本
Office 20xx 
閱讀權限
150 
性別
男 
來自
台北 
註冊時間
2010-4-30 
最後登錄
2026-7-16 

2025年全勤獎章2024年全勤獎章2023年全勤獎章2022虎年全勤獎章2021牛年全勤獎章2020鼠年全勤獎章2019 豬年全勤獎章2018 狗年全勤獎章2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱心公益勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2013-5-7 21:16 | 顯示全部帖子
本帖最後由 Hsieh 於 2013-5-8 07:19 編輯

回復 1# incest1224
沒有檔案測試，你先試試看吧
  1. Sub ex()
  2. Dim Ar(), i%, C$, A As Range
  3. With Sheets(1) '第一張工作表
  4. C = .[B2].Value '要篩選的值
  5.    For i = 2 To Sheets.Count '從第2張工作表開始回圈
  6.       With Sheets(i)
  7.          For Each A In .UsedRange.Columns(1).Cells 'A欄已使用儲存格做迴圈
  8.             If A = C Then '如果與要篩選的值相同
  9.                ReDim Preserve Ar(s)
  10.                Ar(s) = A.Resize(, 10) '將該列A:J欄寫入陣列
  11.                s = s + 1
  12.             End If
  13.          Next
  14.       End With
  15.     Next
  16. .[A6].CurrentRegion.Offset(1).ClearContents '清除舊有資料
  17. If s > 0 Then .[A7].Resize(s, 10) = Application.Transpose(Application.Transpose(Ar)) '若有符合項目則寫入工作表1的A7以下位置
  18. End With

  20. End Sub
複製代碼
學海無涯_不恥下問

TOP

        靜思自在 : 一個人不怕錯，就怕不改過，改過並不難。
返回列表 上一主題