No.3ベストアンサー
- 回答日時:
自作のVBAプログラムを乗せますので使ってみてください。
(1)A,B,C等のエクセルファイルは、すべて同じ名前のシート(今は、dataシートとします)に必要なデータが同じ形で入っていること。
(2)集計用エクセルファイル名は、D.xlsという名前で、そこにsearchシートとworkシートを作っておきます。
(3)A,B,C,Dファイルはすべて同じフォルダに入れておきます。ここには余分なエクセルファイルは入れないようにします。
(4)あとは、D.xlsを立ち上げて、マクロから、Filesearchを実行。
searchシートにフォルダ内のすべてのファイル名と場所が一覧で出ます。またworkシートには各A,B,Cの必要な範囲のデータが、上から順に追加はりつけされます。
(5)各範囲、名前の変更は、あとのコードの「各値初期設定」の所を変更します。
(6)注意点:これは自分の仕事(アンケート集計用)に作りましたので、各ファイルの1行目は項目タイトルなっています。そのため、1行目はコピーしません。1行目からコピーしたい場合は、'各シートからデータをMainに追加貼り付け の場所の、cells(i+1,j) cells(Dline+1,j)をcells(i,j) cells(Dline,j)になおせばいけるはずです。
以下のコードを貼り付けしましょう。GoodLuck!
Sub FileSearch(): 'ファイル検索
Dim sfolda As String
Dim SName As String
Dim i, j, k, n As Integer
Dim ww As String
Dim L, S As Integer
Dim ws As Object
Dim DName As String
Dim KName As String
Dim MainName As String
Dim PP, FF As String
Dim MaxG, DKoumoku, DLine As Integer
Dim MaxFileSu As Integer
Application.ScreenUpdating = False
'各値初期設定=======================================================
DName = "work": '集計シート名
KName = "data": '合成処理をする各ファイルのシートの名前
MainName = "D.xls": '集計用エクセルファイル名
MaxFileSu = 50: '合成処理をするファイルの最大数
DKoumoku = 13: '合成処理をする横方向の項目数
MaxG = 15: '合成処理をする各ファイルのデータの行数
'====================================================================
DLine = 1: 'データ入力行数カウント
'現在のフォルダのパスを設定
sfolda = ThisWorkbook.Path
'ファイル名を入れるシートをセットおよび初期化
Set ws = Workbooks(MainName).Worksheets("search")
ws.Range("B1").ClearContents
ws.Range("A4:B200").ClearContents
ws.Cells(1, 2).Value = sfolda
'各ファイル名を検索しsearchシートに登録
SName = "*.xls"
n = 1
With Application.FileSearch
.LookIn = sfolda
.Filename = SName
rs1 = .Execute
If rs1 = 0 Then Exit Sub
For Each nm In .FoundFiles
ww = nm
S = 1
While S > 0
S = InStr(1, ww, "\", 1)
L = Len(ww)
ww = Right(ww, L - S)
Wend
If ww <> MainName Then
ws.Cells(n + 3, 1).Value = n: '1列目に番号セット
ws.Cells(n + 3, 2).Value = ww: '2列目にファイル名セット
n = n + 1
End If
Next nm
End With
'======================================================================
'合成処理
For n = 1 To MaxFileSu
'ファイル名をセット
PP = ws.Cells(1, 2).Value
If ws.Cells(n + 3, 2).Value = "" Then Exit For
FF = ws.Cells(n + 3, 2).Value
PP = PP & "\" & FF
'ファイルオープン
Workbooks.Open (PP)
'各シートからデータをMainに追加貼り付け
For i = 1 To MaxG
For j = 1 To DKoumoku
aa = Workbooks(FF).Worksheets(KName).Cells(i + 1, j).Value
Workbooks(MainName).Worksheets(DName).Cells(DLine + 1, j).Value = aa
Next j
DLine = DLine + 1
Next i
'ファイルクローズ
Workbooks(FF).Close
Next n
End Sub
この回答への補足
回答ありがとうございます。マクロを作ったことが無いので、恐縮ですが、複数のファイルの抽出したいデータ範囲をG3のみにしたい場合は、どこを変えればよいでしょうか?また上から並べて貼り付ける場合、行を隙間無く埋めたいのですが、どうしたらよいでしょうか?
補足日時:2008/09/14 07:15No.2
- 回答日時:
>一応上記マクロをコピーして実行しましたがうまくいきませんでした。
ということですが、そのまま実行されたのですか?
実際に合わせて、ブック名、シート名を書き換える必要はないのですか?
対象ブックを全て開いた状態でマクロを実行してください。
うまくいかなかった内容の説明はできますか?
エラーは出なかったのですか?
エラーが出たなら、その内容と発生行を教えてください。
メッセージボックスの「デバッグ」ボタンを押せばエラー発生行にジャンプします。
No.1
- 回答日時:
マクロでは駄目ですか?
Sub test()
Dim dwbs As Object
Dim rng As Range
Dim wbn As Variant
Dim rwn As Long
Dim i As Integer
wbn = Array("A.xls", "B.xls", "C.xls")
Set dwbs = Workbooks("D.xls").Worksheets("抽出")
For i = 0 To UBound(wbn)
With dwbs
rwn = .Cells(Rows.Count, "E").End(xlUp).Offset(1, 0).Row
Set rng = .Range(.Cells(rwn, "A"), .Cells(rwn, "E"))
End With
rng.Value = Workbooks(wbn(i)).Worksheets("Sheet1").Range("A1:E1").Value
Next i
End Sub
この回答への補足
すみません。マクロは詳しくないもので、一応上記マクロをコピーして実行しましたがうまくいきませんでした。(私の知識不足です)
それと補足としてファイルを開かずに任意のファイルを選択して、その中で自分の抽出したいセル範囲を選択できて、それを新規エクセルファイルに並べてコピーしたいのですが・・・
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2023/08/03 11:27
- Visual Basic(VBA) Excelのマクロについて教えてください。 1 2023/03/12 12:16
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2023/08/03 12:30
- Excel(エクセル) エクセルの複写について 4 2022/04/10 01:02
- Visual Basic(VBA) Excelのマクロコードについて教えてください。 1 2022/03/27 13:25
- Visual Basic(VBA) VBA初心者です。電話番号の数字の前に0を表示させたいです。 2 2022/12/14 03:58
- Excel(エクセル) 条件に合った数値の合計を表示させたい関数と条件指定の方法 3 2023/05/13 16:07
- Excel(エクセル) エクセル、画像ファイル名の書かれたセル(複数個所)に画像を一括で表示させる方法 1 2023/04/19 00:19
- Excel(エクセル) 【VBA】指定フォルダに格納中のテキストファイルをエクセルで処理し結果のエクセルを新規フォルダに保存 1 2022/03/25 14:19
- その他(プログラミング・Web制作) pythonでクラスで複数のメソッドを利用する方法 2 2022/04/15 04:17
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
VBA シートをコピーする際に Co...
-
ワイルドカード「*」を使うとう...
-
エクセルVBAが途中で止まります
-
vbaで他のブックに転記したい。...
-
別ブックをダイアログボックス...
-
ACCESSでExcelにデータ出力、高...
-
VBS Bookを閉じるコード
-
VBA コードを実行すると画面が...
-
転記先VBA 一致しているセルが...
-
vbaでvbaProjectのパスワード解...
-
VBAで別ブックのシートを指定し...
-
エクセルのマクロについて教え...
-
VBA 実行時エラー 2147024893
-
ExcelVBA:すでに開かれている...
-
【Excel VBA】書き込み先ブック...
-
【ExcelVBA】インデックスが有...
-
【ご教示ください】VBAの記述方...
-
ADOで複数のBookから抽出
-
ACCESSVBA からExcelの他ブック...
-
【ExcelVBA】zip圧縮されたCSV...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
VBA シートをコピーする際に Co...
-
エクセルVBAが途中で止まります
-
別ブックをダイアログボックス...
-
【ExcelVBA】インデックスが有...
-
ワイルドカード「*」を使うとう...
-
【ExcelVBA】VBA実行でダイアロ...
-
ExcelのVBAです。フォルダ内の...
-
フォルダ内の全てのファイルに...
-
VBA コードを実行すると画面が...
-
VBA 別ブックからコピペしたい...
-
VBAで別ブックのシートを指定し...
-
VBS Bookを閉じるコード
-
vbaでvbaProjectのパスワード解...
-
【VBA】全シートの計算式を全て...
-
VBA シート名が一致した場合の...
-
【ExcelVBA】zip圧縮されたCSV...
-
複数のエクセルブックをひとつ...
-
VBSでExcelのオープン確認
-
VBAで別のブックにシートをコピ...
-
【Excel VBA】書き込み先ブック...
おすすめ情報