Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

5573 / 76732

←次へ　｜　前へ→


	【76769】複数のエクセルファイルから条件に一致する行のみを抽出したい

M - 15/3/10(火) 21:23 -


	引用なし

	パスワード

特定のデータフォルダに複数のエクセルファイルデータがあり、それを一つのエクセルﾌｧｲﾙに抽出する際に、今開いているエクセルファイルのシート1のA列に80個程度数値があり、その数値とデータファイルのC列が一致した場合のみ、データファイルの一致した行を抽出マクロを検討しています。
　以下のコードで組んでみたのですが、最初の一行しか抽出せずに、一行目に上書きされてしまいます。どのようにしたらよいのでしょうか。
良ければご意見お願いいたします。

Sub Sample()
Const FolderPath As String = "C:\Users\140328\Desktop\新しいフォルダー"
Dim objFSO As Object
Dim objBook As Object
Dim LastRow As Long
Dim i As Integer
Dim STRcsv As Variant
Dim kijun As Variant

Application.ScreenUpdating = False '画面のちらつき制御設定

Set objFSO = CreateObject("Scripting.FileSystemObject") 'FileSystemObjectを変数にセット

For Each objBook In objFSO.GetFolder(FolderPath).Files 'フォルダ内のファイル全て繰り返し処理
　
Workbooks.Open objBook.Path 'ファイルを開く

　LastRow = ActiveWorkbook.Sheets(1).Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Row '各シートのデータ(最終行+1)の取得
　
　　For i = 1 To 750
　　
　　 If ThisWorkbook.Sheets(1).Cells(i, 1) = ActiveWorkbook.Sheets(1).Cells(i, 3) Then
　　　 ActiveWorkbook.Sheets(1).Rows(i).Copy ThisWorkbook.Sheets(2).Rows(i)
　　 Else
　　　
　　 End If
　
　　Next i
　
　ActiveWorkbook.Close 'コピー後ファイルを閉じる
　
　Next

'オブジェクト変数解放
Set objFSO = Nothing

'画面のちらつき制御解除
Application.ScreenUpdating = True

End Sub

1,159 hits

▼

【76769】複数のエクセルファイルから条件に一致する行のみを抽出したい M 15/3/10(火) 21:23