Google グループは Usenet の新規の投稿と購読のサポートを終了しました。過去のコンテンツは引き続き閲覧できます。
表示しない

複数のファイルの特定のシートの内 容を読み込み特定のシートに貼り付ける

閲覧: 2 回
最初の未読メッセージにスキップ

ETC Sapporo

未読、
2003/06/10 0:09:562003/06/10
To:
また、質問です。

表題の通りなのですが、
複数のファイルの特定のシートの内容を読み込み特定のシートに貼り付ける
マクロプログラムを作ろうとしています。
良い材料になるものはありますでしょうか?
なかなか出来なく悩んでいます。

よろしくお願いいたします。

--------------------------------
Yoshiaki Kawajiri
yoshiaki...@toll.co.jp

shibata mituru

未読、
2003/06/10 7:26:352003/06/10
To:

下記のVBを参考にしてください


Option Explicit
Const Search_SheetName As String = "検査デ-タ月まとめ" '検索するSheetの名前
'
Sub Macro1()
'
Dim Search_ProName$ '検索したBOOKの名前 ***.XLS
Dim Search_Pro$ '検索したBOOKの名前 ***
Dim Dir_Name$ '検索するデレクトリの名前
'
Dir_Name$ = "C:\PRO" 'BOOKを検索するデレクトリを入力
Search_ProName$ = Dir(Dir_Name$ & "*.XLS", 6) '***.XLSを検索
Do Until Search_ProName$ = "" '無くなるまで検索
Workbooks.Open Dir_Name$ & Search_ProName$, UpdateLinks:=0,
ReadOnly:=True '検索したBOOKを読む
Search_Pro$ = ActiveWorkbook.Name '検索したBOOKの名前を取る
If Search_Sheets Then GoTo No_Sheet 'シートを探す
Windows(Search_Pro$).Activate: Sheets(Search_SheetName).Select 'シート
をSELECT
'
'’シートを処理する
'
No_Sheet:
Windows(Search_Pro$).Activate '検索したBOOKををSELECT
Workbooks(Search_Pro$).Close SaveChanges:=False '検索したBOOKを消す
Search_ProName$ = Dir() '次の***.XLSを検索
Loop
End Sub
'
Function Search_Sheets() As Boolean
On Error GoTo No_Sheet_Error
Search_Sheets = False: Sheets(Search_SheetName).Select: Exit Function
No_Sheet_Error:
Search_Sheets = True
End Function


新着メール 0 件