特定の場所に保存してあるファイルを1つのファイルに結合

特定のフォルダにCSVファイルなどに複数ファイル保存してある場合一つ一つのファイルを開いて確認するのは大変です。

そこで、今回は、特定のフォルダに保存してあるファイルを一つのファイルに結合させるVBAを共有したいと思います。

今回の例のフロー

Excelシートに【データ】というシートを作成します。

次に結合するVBAを書きます

Sheets(“データ”).Select

     Range(“A2”).Select

    Range(Selection, Selection.End(xlToRight)).Select

    Range(Selection, Selection.End(xlDown)).Select

    Selection.ClearContents

    Range(“A1”).Select

Application.ScreenUpdating = False ‘画面更新を一時停止

Const FolderPath As String = “” ’フォルダ場所を指定して下さい。

Set mb = ThisWorkbook

Fname = Dir(FolderPath & “\*.csv”) ’フォルダ内のcsvファイルを検索 必要に応じて拡張子を変更して下さい。

Do Until Fname = Empty ‘全て検索し終えると、fname = Empty となるので、その間以下を実行

If Fname <> mb.Name Then ‘ファイル名がこのファイルじゃなければ

Set wb = Workbooks.Open(FolderPath & “\” & Fname) ‘選択したファイルを開く

wb.Worksheets.Copy Before:=mb.Sheets(mb.Sheets.Count) ‘コピーしてまとめ用ブック末尾に置く

wb.Close ‘選択したファイルを閉じる

n = n + 1 ‘ブック数をカウント

End If

Fname = Dir ‘選択したフォルダ内の次のExcelファイルを検索します

’ここでは、データシートにデータを貼り付けします。

 Range(“A18:B18”).Select

    Range(Selection, Selection.End(xlToRight)).Select

    Range(Selection, Selection.End(xlDown)).Select

    Application.CutCopyMode = False

    Selection.Copy

    Sheets(“データ”).Select

    Range(“A10000”).End(xlUp).Select    ‘EntireRow.Select 行全体

    ActiveCell.Offset(1, 0).Select

    ActiveSheet.Paste

    Application.CutCopyMode = False

Loop ‘繰り返す

Application.ScreenUpdating = True ‘画面更新一時停止を解除

MsgBox “データを取込みました。”

次に、データシート以外を削除するVBAを書きます。

Dim targetSheet     As Worksheet    ‘繰り返し用

‘警告メッセージを表示しない

Application.DisplayAlerts = False

‘削除処理

For Each targetSheet In Worksheets

    If targetSheet.Name <> “データ” Then            targetSheet.Delete

    End If

Next

‘警告メッセージを表示

Application.DisplayAlerts = True

まとめ

フォルダ内の複数ファイルを一つのシートへ簡単にまとめる事が出来ます。

日々データをコピペし、データ分析を行ってい場合などに非常に有効的な自動化です。

Microsoft Public Affiliate Program (JP)(マイクロソフトアフィリエイトプログラム)

3件のコメント

  1. talk online for free online marriage sites in usa eris free
    downloads chatting apps tinder dating site

  2. talk online for free online marriage sites in usa eris free downloads chatting apps https://onlinedatinghunks.com/

  3. Superb, what a webpage iit is! This website provides helpful information to us,
    keepp itt up.

コメントする

メールアドレスが公開されることはありません。 が付いている欄は必須項目です