hiko-blog

VBA業務改善

MENU

条件に応じてコピー

Sub CopyFormulasBasedOnCriteria()
    Dim wsSource As Worksheet
    Dim wsTemplate As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim copyRow As Long
    Dim pasteRow As Long

    ' シートをセットアップ
    Set wsSource = ThisWorkbook.Sheets("Data")
    Set wsTemplate = ThisWorkbook.Sheets("ひな形")

    ' 最終行を取得
    lastRow = wsSource.Cells(wsSource.Rows.Count, "C").End(xlUp).Row

    ' C列をループ
    For i = 1 To lastRow
        ' C列の値をチェック
        If wsSource.Cells(i, "C").Value = "AAAA" Then
            copyRow = 2
        ElseIf wsSource.Cells(i, "C").Value = "BBBB" Then
            copyRow = 4
        ElseIf wsSource.Cells(i, "C").Value = "CCCC" Then
            copyRow = 6
        Else
            ' 他の場合はスキップ
            Continue For
        End If

        ' コピー元の範囲を定義
        wsTemplate.Range("N" & copyRow & ":U" & copyRow).Copy

        ' 貼り付け先の行を計算
        pasteRow = i

 

   ' N列に貼り付け(値のみ)
        ’wsSource.Range("N" & pasteRow).PasteSpecial Paste:=xlPasteValues

 

  ' N列に貼り付け(計算式を含んだまま)
        wsSource.Range("N" & pasteRow).PasteSpecial Paste:=xlPasteFormulas
        Application.CutCopyMode = False ' コピー解除
    Next i
End Sub