別ファイルのデータを転記するにあたり、1行目から最終行まで取得したいです。

実現したいこと

別ファイルのデータを転記するにあたり、1行目から最終行まで取得し転記したいです。

前提

1日分ずつのデータしか出力できないアプリを使用することになったのですが、数ヶ月分のファイルを1つ1つ開いて転記するのが大変です。
ネットで検索し複数ファイルのデータを集約し転記することができるコードを参考にさせていただいたのですが、元データの1行目(日付の記載欄があるのです)は取得できないようでして、どうしたらよいのか困っています。当方マクロ未経験のため、どうかお力を貸していただけますと幸いです。
アプリから出力されたファイルは1行目のB1のセルに日付が記載されており、B1~G1のセルが結合されています。

発生している問題・エラーメッセージ

参考にさせていただいたコードのおかげで2行目~最終行の取得はできるのですが、最初の行から取得したい場合どうしたらよいのか分かりません。

該当のソースコード

Option Explicit 'プログラム1|プログラム開始 Sub GetExcelDataInFolder() 'プログラム2|シート設定 Dim ws1 As Worksheet Set ws1 = ThisWorkbook.Worksheets("Sheet1") 'プログラム3|FileSystemObjectの設定 Dim fs As FileSystemObject Set fs = New FileSystemObject 'プログラム4|対象フォルダを取得 Dim myfolder As Folder Set myfolder = fs.GetFolder(ThisWorkbook.Path) 'プログラム5|対象フォルダ内の全ファイルを処理 Dim myfile As File For Each myfile In myfolder.Files 'プログラム6|拡張子が「xlsx」のファイルのみを処理 If fs.GetExtensionName(myfile) = "xlsx" Then 'プログラム7|フォルダ内のエクセルを開いてシートを設定 Dim wb As Workbook Set wb = Workbooks.Open(Filename:=myfile) Dim ws2 As Worksheet Set ws2 = wb.Worksheets(1) 'プログラム8|開いたエクセルの最終行を取得 Dim cmax As Long cmax = ws2.Range("BH65536").End(xlUp).Row Debug.Print myfile.Name & "のcmax=" & cmax 'プログラム9|開いたエクセルのデータを転記 Dim i As Long For i = 1 To cmax Dim cmax1 As Long cmax1 = ws1.Range("BH65536").End(xlUp).Row ws1.Range("A" & cmax1 + 1 & ":BH" & cmax1 + 1).Value = ws2.Range("A" & i & ":BH" & i).Value Next 'プログラム10|エクセルを閉じる wb.Close 'プログラム11|オブジェクト解放 Set ws2 = Nothing Set wb = Nothing End If Next 'プログラム12|エクセルを保存 ThisWorkbook.Save 'プログラム13|オブジェクト解放 Set myfolder = Nothing Set fs = Nothing 'プログラム14|プログラム終了 End Sub

試したこと

プログラム9内の「+ 1」を「- 1」に変更したところマクロ実行時に1行目を取得している瞬間を目撃しましたがその後その後うまく転記されず・・・お手上げです。

補足情報(FW/ツールのバージョンなど)

ここにより詳細な情報を記載してください。

コメントを投稿

0 コメント