080 視聴者さん要望① VBAで自動転記

自動転記VBAのソースコードです！

各自アレンジして使ってみてくださいね！

(テンプレートのExcelファイルも忘れずにね！)

動画はこちら！

https://www.youtube.com/watch?v=mtycTMPNA4g

以下ソースコード

----------------------------------------------------------------------------------

Option Explicit

Sub DataInput()

Dim i As Integer '転記元の行数を取得

Dim strPath As String '本ファイルのパス(フォルダ)

Dim wsMe As Worksheet '本ファイル 転記元のシート

Dim strSaveFile As String '保存ファイル名

Dim wsForm1 As Worksheet, wsForm2 As Worksheet '転記元のシート

Application.ScreenUpdating = False '画面表示更新をストップする

Application.Calculation = xlCalculationManual '計算を手動に

Set wsMe = ThisWorkbook.Worksheets("リスト")

strPath = ThisWorkbook.Path '本ファイルのパス(フォルダ)を取得

i = 5 '5行目以降が入力箇所

Do While wsMe.Cells(i, 1) <> "" 'データ未入力の行まで進む

    Workbooks.Open strPath & "\テンプレート.xlsx" '開く

    Set wsForm1 = Workbooks("テンプレート.xlsx").Worksheets("申込フォーム") '転記先のシートをセット

    Set wsForm2 = Workbooks("テンプレート.xlsx").Worksheets("入力担当") '転記先のシートをセット

    

    wsForm1.Cells(5, 4).Value = wsMe.Cells(i, 1).Value

    wsForm1.Cells(5, 5).Value = wsMe.Cells(i, 2).Value

    wsForm1.Cells(6, 4).Value = wsMe.Cells(i, 3).Value

    wsForm1.Cells(6, 5).Value = wsMe.Cells(i, 4).Value

    wsForm1.Cells(8, 4).Value = wsMe.Cells(i, 5).Value

    wsForm1.Cells(9, 4).Value = wsMe.Cells(i, 6).Value

    wsForm1.Cells(10, 4).Value = wsMe.Cells(i, 7).Value

    wsForm1.Cells(12, 3).Value = wsMe.Cells(i, 8).Value

    wsForm1.Cells(12, 5).Value = wsMe.Cells(i, 9).Value

    wsForm2.Cells(2, 1).Value = wsMe.Cells(1, 2).Value '※固定

    wsForm2.Cells(2, 2).Value = Now() '※固定

    

    strSaveFile = wsMe.Cells(i, 10).Value & "_" & Format(wsForm2.Cells(2, 2).Value, "yyyymmddhhmmss") & ".xlsx"

    Workbooks("テンプレート.xlsx").SaveAs Filename:=strPath & "\" & strSaveFile

    Workbooks(strSaveFile).Close '閉じる

    i = i + 1

Loop

Application.ScreenUpdating = True '画面表示更新する

Application.Calculation = xlCalculationAutomatic '計算を自動に戻す

MsgBox "完了", vbInformation

End Sub