機能ブログ1-別のエクセルから内容を複写

とても簡単な処理ですけど、マクロ自動化により、結構手間を省いてくれます。

■　処理内容
①　指定されたセル範囲の内容をクリア
②　別のエクセルブックからシート内容を複写
③　セル内容を編集

Sub MAIN()

    Dim Wbook1_FULLNM As String
    Dim Wbook2_FULLNM As String
    Dim BOOK1_NM As String
    Dim BOOK2_NM As String

    Wbook1_FULLNM = ThisWorkbook.Path & "\book1.xlsx"
    Wbook2_FULLNM = ThisWorkbook.Path & "\book2.xlsx"
    BOOK1_NM = "book1.xlsx"
    BOOK2_NM = "book2.xlsx"

    Dim WbCopy As Workbook

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual

    Call doClear  '①セル

    'book1.xlsxに対する処理(PARA：処理対象Excelのobjインスタンス,処理対処Excelのフルパス名、処理対象Excel名)
    Call doOpenWkbook(WbCopy, Wbook1_NM, BOOK1_NM)
    Call doCopyPaste_BOOK1(WbCopy)
    Call doCloseWkbook(WbCopy)

    Call doEditData

    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = xlCalculationAutomatic

End Sub

Sub doOpenWkbook(WbCopy As Workbook, file As String, fileNM As String)

    Workbooks.Open Filename:=file, Password:="×××××××××××××××"
    Set WbCopy = Workbooks(fileNM)

End Sub


Sub doCloseWkbook(WbCopy As Workbook)
    WbCopy.Close
End Sub

Sub doClear()
    Dim rowStart As Long
    Dim rowEnd As Long
    Dim colStart As Long
    Dim colEnd As Long
    colStart = 1  '固定値で指定
    colEnd = 150  '固定値で指定

    With Worksheets("sheet1")
        .Activate
        rowEnd = .Cells(Rows.Count, 2).End(xlUp).Row '最後のセルの行
        .Range(.Cells(3, 1), .Cells(rowEnd, colEnd)).Clear
    End With
    With Worksheets("sheet2")
        .Activate
        rowEnd = .Cells(Rows.Count, 2).End(xlUp).Row '最後のセルの行
        .Range(.Cells(3, 1), .Cells(rowEnd, colEnd)).Clear
    End With
    With Worksheets("sheet3")
        .Activate
        rowEnd = .Cells(Rows.Count, 2).End(xlUp).Row '最後のセルの行
        .Range(.Cells(3, 1), .Cells(rowEnd, colEnd)).Clear
    End With

End Sub

Sub doCopyPaste_BOOK1(WbCopy As Workbook)
    Dim rowMax As Long
    Dim colEnd As Long
    colEnd = 150  '
    With WbCopy.Worksheets("Sheet①")
        .Activate
        rowMax = .Cells(Rows.Count, 1).End(xlUp).Row '縦方向
        .Range(.Cells(9, 1), .Cells(rowMax, colEnd)).Copy
        ThisWorkbook.Worksheets("Sheet1").Range("B3").PasteSpecial Paste:=xlPasteValues '値だけペースト
        Application.CutCopyMode = False
    End With

    With WbCopy.Worksheets("Sheet②")
        .Activate
        rowMax = .Cells(Rows.Count, 1).End(xlUp).Row '縦方向
        .Range(.Cells(9, 1), .Cells(rowMax, colEnd)).Copy
        ThisWorkbook.Worksheets("Sheet2").Range("B3").PasteSpecial Paste:=xlPasteValues '値だけペースト
        Application.CutCopyMode = False
    End With
End Sub

Sub doEditData()
    Dim rowStart As Long
    Dim rowEnd As Long

    With Worksheets("Sheet1")
        .Activate
        rowEnd = .Cells(.Rows.Count, 2).End(xlUp).Row '縦方向
        'A列編集
        For i = 1 To rowEnd Step 1
            .Range("A" & i).Value = .Range("B" & i).Value & .Range("C" & i).Value
        Next
    End With

    With Worksheets("Sheet2")
        .Activate
        rowEnd = .Cells(.Rows.Count, 2).End(xlUp).Row '縦方向
        'A列編集
        For i = 1 To rowEnd Step 1
            .Range("A" & i).Value = .Range("B" & i).Value & .Range("C" & i).Value
        Next
    End With
End Sub