为名为 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

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

Copy paste range of cells for every row called xxxx

excel

vba

copy-paste

range

剪切粘贴

剪辑版

复制 ClearContents 版本