VBA – 复制给定的单元格与条件匹配
注意到一些类似的问题，所以我很抱歉，如果这似乎是重复 – 但我一直无法修改以前的build议，以满足我的需要，由于我对VBA的理解不够。
我有两个选项卡，称为“原始X”和“X”。 我试图达到的是：
如果“原始X”中的列N = 4，则不要复制它。
如果“原始X”<> 4中的列N，则需要将其复制到“X”
棘手的部分（我认为）是我不希望整个行，只是某些细胞。 因此，从“原始X”开始，需要将单元C，D，E，K，L和M分别复制到“X”单元H，I，K，L，M和N中。
我正在和尝试修改的VBA在下面，但是对于我来说，一旦它的唯一的某些单元需要复制，它就变得太复杂了。
Sub RoundedRectangle5_Click() Dim tfCol As Range, Cell As Object Set tfCol = Range("N2:N1000") For Each Cell In tfCol If IsEmpty(Cell) Then Exit Sub End If If Cell.Value <> "4" Then Cell.EntireRow.Copy Sheets."X".Select ActiveSheet.Range("A65536").End(xlUp).Select Selection.Offset(2, 0).Select ActiveSheet.Paste End If Next End Sub Sub RoundedRectangle5_Click() Dim tfCol As Range, _ Cell As Range, _ wsRawX As Worksheet, _ wsX As Worksheet, _ CellVal As String With ThisWorkbook Set wsRawX = .Sheets("Raw X") Set wsX = .Sheets("X") End With 'ThisWorkbook Set tfCol = wsRawX.Range("N2:N1000") For Each Cell In tfCol If IsEmpty(Cell) Then Exit Sub If IsError(Cell.value) Then CopyData wsRawX, Cell.Row, wsX Else If CStr(Cell.value) <> "4" Then CopyData wsRawX, Cell.Row, wsX Else End If End If Next Cell End Sub Sub CopyData(SrcSheet As Worksheet, ByVal SrcRow As Double, DestSheet As Worksheet) Dim NextRow As Double NextRow = DestSheet.Range("H" & DestSheet.Rows.Count).End(xlUp).Row + 2 With SrcSheet 'C and D to H and I .Range("C" & SrcRow & ":D" & SrcRow).Copy DestSheet.Range("H" & NextRow) 'E to K .Cells(SrcRow, "E").Copy DestSheet.Range("K" & NextRow) 'K, L and M to L, M and N .Range("K" & SrcRow & ":M" & SrcRow).Copy DestSheet.Range("L" & NextRow) End With 'wsRawX End Sub