ばくがの業務効率化チャンネル

このブログは個人的なエクセルの備忘録です

VBA 最終行の下に転記

Option Explicit
Sub 最終行の下に転記()

    '同じフォルダ内のファイルを開いてコピーする

    'パスとファイル名の変数宣言
    Dim 保存場所 As String, ファイル名 As String

    '転記先と転記元の変数宣言
    Dim 転記先, 転記元 As Workbook
    Dim 転記先の最終行, 転記元の最終行 As Long
    Dim この範囲 As Range
    
    Set 転記先 = ActiveWorkbook
    
     '最終行の取得
    転記先の最終行 = Worksheets("集約").Cells(Rows.Count, 1).End(xlUp).Row + 1
    転記元の最終行 = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Row
             
            
            '保存場所パス
             保存場所 = "C:\Users\Desktop\クレジットカード\"
            'ファイル名
             ファイル名 = Dir(保存場所 & "detail*.CSV")
   
            '転記元を読み取り専用で開く
             Workbooks.Open 保存場所 & ファイル名, ReadOnly:=True
    
            Set 転記元 = Workbooks.Open(保存場所 & ファイル名)
            Set この範囲 = 転記元.Sheets(1).Range("A1").CurrentRegion.Offset(1, 0)
            
            この範囲.Resize(この範囲.Rows.Count - 1).Copy 転記先.Worksheets("集約").Range("A" & 転記先の最終行)
     
        'マスターデータ取り込み先のファイルを閉じる
        
        転記元.Close False
        
End Sub