Попытка переместить диапазон в электронной таблице Excel в другую электронную таблицу на основе значения в столбце

Question

У меня есть этот код, который работает довольно хорошо, я хотел бы внести в него несколько изменений, и я не знаю точно, как это сделать.

Sub movetosheet2()

    Dim xRg As Range
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Sheet1").UsedRange.Rows.Count
    J = Worksheets("Sheet2").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Sheet2").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Sheet1").Range("C1:C" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "Done" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Sheet2").Range("A" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Done" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
End Sub

Я хотел бы скопировать только диапазон вместо целой строки. Поэтому, если этот код копирует строку 8 из листа 1 в лист 2, я хотел бы вместо этого скопировать C8:J8 . Кроме того, вместо удаления строки 8 на листе 1, я бы предпочел, чтобы я мог очистить содержимое C8:J8 на листе 1.

Answer 1

Если этот код копирует строку 8 из листа 1 в лист 2, я хотел бы вместо этого скопировать C8:J8 .

Dim rng As Range, r As Long
r = 8 ' Your Row #
Set Rng = Range("C" & r & ":J" & r)

---

Кроме того, вместо удаления строки 8 на листе 1, я бы предпочел, чтобы я мог очистить содержимое C8:J8 на листе 1.

Возьмите тот же самый объект rng сверху:

rng.ClearContents