复制称为xxxx的每一行的单元格粘贴范围

Question

我有这个工作表，我想移动（通过复制和粘贴）几周的范围，以及每行称为计划的行。下面是一个我正在使用的简单脚本，但是如果可能，我想创建它的循环吗？

我很容易地将范围从E列复制并粘贴到O列。将其粘贴在D列中，然后返回到O列并删除其中的任何值。

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>   

Answer 1

剪切粘贴

剪切版本

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

复制ClearContents版本

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