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

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

配列による方法：別ブック（複数）のデータを別ブックのシートにまとめる・配列 

Power Queryを使う方法もあります。

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

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

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

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

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

シートは全て「購入品」

転機後

エクセル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