目安箱 IV

目安箱投稿のルールはこちらをごらんください。
ご意見は電子メールで承っています。
「目安箱」は質問禁止です。技術的な質問はそれぞれの質問箱へどうぞ。

迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
21 / 118 ツリー ←次へ | 前へ→

【275】複数ファイルから、対象データの抽出 VBA初心者 11/10/24(月) 10:52 Excel[未読]

【275】複数ファイルから、対象データの抽出
Excel  VBA初心者  - 11/10/24(月) 10:52 -

引用なし
パスワード
   こんにちは、VBA初心者です。
過去のファイルを管理しやすいように、VBAにて検索&表示画面を作ろうかと思ったんですが、うまくいきません。。
色々なサイトで紹介されているプログラミングを参考に、以下のコードを作成しました。

複数個ある、過去ファイルから条件に合う行をそれぞれ一行ずつコピーして一覧を作成したいのですが、フィルタまではうまく動くのですが、タイトル行を削除しようとするとエラーになります。
(下記プログラムで★の部分)
どうやら原因はtbl.Rows.Count の値が1になっているようなのですが、最後の「 Workbooks(b4Table.Name).Close SaveChanges:=False」をコメントアウトして、ファイルを表示してみるとタイトル行以外にも一行表示されています。。。

VBA上級者の皆様の力を貸して下さい。よろしくお願いします!
ちなみにExcel2007を使ってます。

Sub display()

Dim b4Table As Object
Dim fso As Object
Dim CasNo, Row As Integer
Dim CalNo As String

Set fso = CreateObject("Scripting.FileSystemObject")
Row = 7
Application.ScreenUpdating = False
  
   For Each b4Table In fso.GetFolder(ThisWorkbook.Path & "\before\").Files
  
    CalNo = "A" & Row
    
    Workbooks.Open Filename:=ThisWorkbook.Path & "\before\" & b4Table.Name
    
    If ActiveSheet.AutoFilterMode Then
      ActiveSheet.AutoFilterMode = False
    End If

    Workbooks(b4Table.Name).Worksheets(1).Range("1:500").AutoFilter _
    field:=5, Criteria1:=ThisWorkbook.Worksheets(1).Range("C2")
    Range(CalNo).CurrentRegion.Select
    Set tbl = Range(CalNo).CurrentRegion.SpecialCells(xlCellTypeVisible)
    MsgBox ("tbl.Rows.Count = " & tbl.Rows.Count)

      ★tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).Select
      tbl.Copy ThisWorkbook.Worksheets(1).Range(CalNo)
      tbl.AutoFilter
   
     Workbooks(b4Table.Name).Close SaveChanges:=False
    
    Row = Row + 1
   Next

Application.ScreenUpdating = True

Set fso = Nothing

End Sub

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
21 / 118 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:   
0
(SS)C-BOARD v3.8 is Free