Question

我有用于将“ B”列中的值与单元格“ M15”中的值进行匹配的代码，然后复制并删除这些行。

我只需要复制和删除一个范围（A到J），而不是整个行。

Sub MoveRows()

Dim Sht1 As Worksheet, Sht3 As Worksheet
Dim tfRow As Range, C As Range 
Dim CopyRng As Range
Dim LastRow As Long

Application.ScreenUpdating = False

Set Sht1 = Sheets("Sheet1")
Set Sht3 = Sheets("Sheet3")
With Sht1
   LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row 

   Set tfRow = .Range("B2:B" & LastRow)

For Each C In tfRow

    If IsEmpty(C) Then
        Exit Sub
    End If

    If C.Value = .Range("M15").Value Then 
        If Not CopyRng Is Nothing Then
            Set CopyRng = Application.Union(CopyRng, C)   
        Else
            Set CopyRng = C
        End If
    End If

Next C
End With

If Not CopyRng Is Nothing Then

   LastRow = Sht3.Cells(Sht3.Rows.Count, "B").End(xlUp).Row
   CopyRng.EntireRow.Copy Destination:=Sht3.Range("A" & LastRow + 1)
   CopyRng.EntireRow.Delete (xlShiftUp)

End If

Answer 1

下面的基本代码使用自动过滤器（快得多，然后循环），并将范围内的可见单元格复制到A列中的第一个空单元格。

删除部分数据将导致行移位并可能破坏数据。我还提供了一行代码，仅清除了您的范围。

Dim ws1 As Worksheet, ws3 As Worksheet, lRow As Long, Rng As Range

Set ws1 = ThisWorkbook.Sheets("Sheet1")
Set ws3 = ThisWorkbook.Sheets("Sheet3")
lRow = ws3.Cells(Rows.Count, 1).End(xlUp).Row
Set Rng = ws1.Range("A1").CurrentRegion

    Rng.AutoFilter Field:=2, Criteria1:=ws1.Range("M15").Value

    ws1.Range(Cells(2, 1), Cells(Rng.Rows.Count, 10)).SpecialCells(xlCellTypeVisible).Copy _
    Destination:=ws3.Range("A" & lRow + 1)

    'You must clear the range and then remove the filter before deleting blank cells.
    ws1.Range(Cells(2, 1), Cells(Rng.Rows.Count, 10)).SpecialCells(xlCellTypeVisible).Clear
    ws1.Cells.AutoFilter
    ws1.Range(Cells(2, 1), Cells(Rng.Rows.Count, 10)).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp

复制一个范围而不是整个行

1 个答案: