Excel

【Excel・VBA】フォルダ内のエクセルデータを転記する

2020-07-07

フォルダ内にあるエクセルファイルのデータを転記する方法です。

転記するデータが多い場合は、手作業でコピー&ペーストを繰り返すと大変すぎです。VBAを使えば早く処理ができます。

Power Queryを使う方法もあり。

→ エクセルのクエリでデータ結合する方法

ここで記載しているコードは、自分のおぼえがきです。もし参考にする場合は、これ以外にも方法はありますので、ご自身でアレンジしてみてください。

エクセルのバージョン:Office Home & Business 2019

やりたいこと・転記元のデータと転記先データ

転記元のデータは3つ

  1. 購入品_1月.xlsx
  2. 購入品_2月.xlsx
  3. 購入品_3月.xlsx

シートは全て「購入品」のみ

転記元データ

この3つのデータを転記するデータ

シートは全て「購入品」

転記先エクセルデータ

転記後

エクセルVBA転記

データの保存先

エクセルの転記・VBA

エクセルVBA

  • データの選択は、ダイアログボックスを表示する方法
  • 転記元のデータのコピーは書式も含めてます
  • D列にファイル名を入力する
Sub f_tenki()
Dim fPath As String
Dim motoFile As String
Dim sakiSheet As Worksheet
Dim sakiLRow, motoLRow, sakiLRow2 As Long   
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = True Then
            fPath = .SelectedItems(1)
        End If
    End With
    If fPath = "" Then End
    
    With Application
      .ScreenUpdating = False
      .DisplayAlerts = False
    End With
        
    Set sakiSheet = ActiveWorkbook.Sheets("購入品")
    
    fPath = fPath & "¥"
    motoFile = Dir(fPath & "*.xlsx")
        
    Do While motoFile <> ""
    
       sakiLRow = sakiSheet.Cells(Rows.Count, 1).End(xlUp).Row
       
       Workbooks.Open Filename:=fPath & motoFile, UpdateLinks:=True, ReadOnly:=True
       motoLRow = Cells(Rows.Count, 1).End(xlUp).Row
        
       Range("A2:C" & motoLRow).Copy sakiSheet.Range("A" & sakiLRow + 1)
       
       sakiLRow2 = sakiSheet.Cells(Rows.Count, 1).End(xlUp).Row
       sakiSheet.Range("D" & sakiLRow + 1 & ":D" & sakiLRow2) = motoFile
              
       Workbooks(motoFile).Close
       motoFile = Dir()
       
     Loop
    
    Range("A1").Select
    
    With Application
      .ScreenUpdating = True
      .DisplayAlerts = True
    End With
  
End Sub

-Excel
-

© 2021 オフィスのQ&A