シート跨ぎ転記(2シート間転記)マクロ
1 転記元シートから転記先シートへの転記
2 コード
Option Explicit '転記先シートのシートモジュールに記載 'シート跨ぎ転記 Private Sub Worksheet_Activate() '転記元シート Dim wsFrom As Worksheet: Set wsFrom = Sheets("sheet1") With wsFrom Dim lastRow As Long lastRow = .Range("C" & .Rows.Count).End(xlUp).Row End With 'sheet2のシートモジュールに書くので、wsToは省略できる Dim wsTo As Worksheet: Set wsTo = Sheets("sheet2") With wsTo '初期化 .Rows("11:" & .Rows.Count).ClearContents '日付入力 .Range("F2").Value = Date '転記 .Range("A11:A" & lastRow).Value = wsFrom.Range("A11:A" & lastRow).Value .Range("B11:B" & lastRow).Value = wsFrom.Range("B11:B" & lastRow).Value .Range("C11:C" & lastRow).Value = wsFrom.Range("C11:C" & lastRow).Value .Range("E11:E" & lastRow).Value = wsFrom.Range("D11:D" & lastRow).Value .Range("F11:F" & lastRow).Value = wsFrom.Range("E11:E" & lastRow).Value .Range("G11:G" & lastRow).Value = wsFrom.Range("F11:F" & lastRow).Value .Range("H11:H" & lastRow).Value = wsFrom.Range("G11:G" & lastRow).Value .Range("I11:I" & lastRow).Value = wsFrom.Range("H11:H" & lastRow).Value End With End Sub '転記先シートのシートモジュールに記載 Sub sheet2並べ替え() '並べ替え With ThisWorkbook.Sheets("sheet2") .Range("A10").Sort _ key1:=Range("H10"), order1:=xlAscending, _ key2:=Range("F10"), order2:=xlAscending, _ Header:=xlYes .Range("A10").Select End With End Sub '転記先シートのシートモジュールに記載 Sub 指定フォルダへ保存() 'シートコピー '新規シートがアクティブになったとき転記イベントを抑止 Application.EnableEvents = False ThisWorkbook.Sheets("sheet2").Copy Application.EnableEvents = True '新規ブックを格納 Dim aWB As Workbook: Set aWB = ActiveWorkbook Dim aWS As Worksheet: Set aWS = ActiveSheet 'パスを格納 With aWS Dim savePath As String: savePath = .Range("K1").Value Dim backupPath As String: backupPath = .Range("K2").Value Dim saveName As String: saveName = Format(Now, "yyyy-mm-dd-hhmmss_") & .Range("K3").Value 'パスを書いておいたセルを削除 .Range("J1:K3").Clear .Range("A10").Select End With With aWB 'xlsx形式で保存 Application.DisplayAlerts = False .SaveAs savePath & "\" & saveName, FileFormat:=xlWorkbookDefault .SaveAs backupPath & "\" & saveName, FileFormat:=xlWorkbookDefault Application.DisplayAlerts = True .Close End With 'フォルダを開く Shell "Explorer.exe " & savePath, vbNormalFocus Shell "Explorer.exe " & backupPath, vbNormalFocus End Sub