Скопируйте диапазон вставки ячеек для каждой строки с именем xxxx - PullRequest
Новая
       26

Скопируйте диапазон вставки ячеек для каждой строки с именем xxxx

0 голосов
/ 17 января 2019

enter image description here

У меня есть этот рабочий лист, который я хочу переместить (путем копирования и вставки) в диапазон недель, а также в каждую строку с именем Plan. Ниже приведен простой скрипт, который я использую, но я хотел бы создать его цикл, если это возможно?

В основном я хочу скопировать и вставить диапазон из столбца 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>

1 Ответ

0 голосов
/ 17 января 2019

Cut Paste

Вырезанная версия 

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 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
...