返回列表下一主題上一主題發帖

想請教,從多個活頁簿找到關鍵字後複製下一列,但一直有錯誤

hasrhgni

小學生 Rank: 1

帖子: 8
主題: 2
精華: 0
積分: 10
點名: 0
作業系統: win7
軟體版本: office 2007
閱讀權限: 10
性別: 男
來自: 桃園
註冊時間: 2014-12-12
最後登錄: 2016-4-13

1^# 跳轉到 » 倒序看帖

打印

字體大小: tT

發表於 2014-12-26 02:54 | 顯示全部帖子

想請教,從多個活頁簿找到關鍵字後複製下一列,但一直有錯誤

想請教,從多個活頁簿找到關鍵字後複製下一列,但一直有錯誤

Sub ex()

Dim Ar(), i%, C$, A As Range

With Sheets(1) '第一張工作表

C = "身分證或統一證號" '要篩選的值

For i = 2 To Sheets.Count '從第2張工作表開始回圈

   With Sheets(i)

      For Each A In .UsedRange.Columns(1).Cells 'A欄已使用儲存格做迴圈

         If A = C Then '如果與要篩選的值相同

            ReDim Preserve Ar(s)

            Ar(s) = A.Offset(1).Resize(, 11) '將該列A:k欄寫入陣列

            s = s + 1

         End If

      Next

   End With

Next

.[A4].CurrentRegion.Offset(1).ClearContents '清除舊有資料

If s > 0 Then .[A5].Resize(s, 11) = Application.Transpose(Application.Transpose(Ar)) '若有符合項目則寫入工作表1的A5以下位置

End With

End Sub

在這一行一直出現錯誤"13"型態不符合,我不知是否我的活頁簿太多,其實活頁簿共有約500頁,如果我1~60頁保留,其後都刪掉,就沒有錯誤
If s > 0 Then .[A5].Resize(s, 11) = Application.Transpose(Application.Transpose(Ar)) '若有符合項目則寫入工作表1的A5以下位置

不知可否幫忙解決,如果能有抓同一資料夾內的.xlsx檔案方法就可好了,我就不用將檔案的活頁簿塞到同一個.xlsx檔裡,我的每個檔只有一個活頁簿