Copy paste range of cells for every row called xxxx

user_10927279 0
Viewed 180

enter image description here

I have this worksheet that I want to move (by copy and paste) range of weeks as well as every row called Plan. Below is a simple Script that I'm using but I would like to create of loop of it if possible?

Basiclly I want to copy and paste range from column E to Column O. Paste it in column D and then go back to column O and remove any value that is there. 

enter code here

<Range("E2:O2").Select    
Selection.Copy    
Range("D2").Select    
ActiveSheet.Paste    
Range("O2").Select    
Selection.ClearContents    


Range("E4:O4").Select    
Selection.Copy    
Range("D4").Select    
ActiveSheet.Paste    
Range("O4").Select    
Selection.ClearContents>
range copy-paste vba excel
1 Answers

Cut Paste

Cut Version

Sub CutPaste()

    Const cSheet As Variant = "Sheet1"      ' Worksheet Name/Index
    Const cFirstS As Variant = "E"          ' Source First Column Letter/Number
    Const cLastS As Variant = "O"           ' Source Last Column Letter/Number

    Const cFirstT As Variant = "D"          ' Target First Column Letter/Number

    Const cFirstRow As Long = 1             ' First Row Number
    Const cCriteria As Variant = "B"        ' Criteria Column Letter/Number
    Const cStrCriteria As String = "Plan"   ' Criteria String

    Dim lastRow As Long   ' Last Row Number
    Dim i As Long         ' Row Counter

    With ThisWorkbook.Worksheets(cSheet)
        lastRow = .Cells(.Rows.Count, cFirstS).End(xlUp).Row
        For i = cFirstRow To lastRow
            If .Cells(i, cCriteria) = cStrCriteria Then
                .Range(.Cells(i, cFirstS), .Cells(i, cLastS)).Cut _
                        Destination:=.Cells(i, cFirstT)
            End If
        Next
    End With

End Sub

Copy ClearContents Version

Sub CopyClearContents()

    Const cSheet As Variant = "Sheet1"      ' Worksheet Name/Index
    Const cFirstS As Variant = "E"          ' Source First Column Letter/Number
    Const cLastS As Variant = "O"           ' Source Last Column Letter/Number

    Const cFirstT As Variant = "D"          ' Target First Column Letter/Number

    Const cFirstRow As Long = 1             ' First Row Number
    Const cCriteria As Variant = "B"        ' Criteria Column Letter/Number
    Const cStrCriteria As String = "Plan"   ' Criteria String

    Dim lastRow As Long   ' Last Row Number
    Dim i As Long         ' Row Counter

    With ThisWorkbook.Worksheets(cSheet)
        lastRow = .Cells(.Rows.Count, cFirstS).End(xlUp).Row
        For i = cFirstRow To lastRow
            If .Cells(i, cCriteria) = cStrCriteria Then
                .Range(.Cells(i, cFirstS), .Cells(i, cLastS)).Copy _
                        Destination:=.Cells(i, cFirstT)
                .Cells(i, cLastS).ClearContents
            End If
        Next
    End With

End Sub
user_98140690
Related