| |
こんにちは、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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
