根据单元格值将特定数据（不是整行！）复制到另一个工作表

Question

我正在尝试根据匹配将单元格数据从一张表复制到另一张表。

我有一个 3 张工作簿。 “地点”、“可乐”和“HMS”。

在活动工作表“Place”上，如果 C14 列有“Coke”一词 - 我希望将 D14-H14 复制到工作表“Coke”。

类似地，如果 C15 包含“HMS” - 我只想将“D15-H15”复制到工作表“HMS”

我有一个宏可以复制整行，而我想要复制特定的单元格 - 它来自特定的 C:H。

Sub As_Of_Analysis_Sorting()
Dim lr As Long, lr2 As Long, r As Long
lr = Sheets("Place").Cells(Rows.Count, "A").End(xlUp).Row
lr2 = Sheets("Coke").Cells(Rows.Count, "A").End(xlUp).Row
lr3 = Sheets("HMS").Cells(Rows.Count, "A").End(xlUp).Row
For r = lr To 2 Step -1
    If Range("C" & r).Value = "Coke" Then
        Rows(r).Copy Destination:=Sheets("Coke").Range("A" & lr2 + 1)
        lr2 = Sheets("Coke").Cells(Rows.Count, "A").End(xlUp).Row
    End If
    If Range("C" & r).Value = "HMS" Then
        Rows(r).Copy Destination:=Sheets("HMS").Range("A" & lr3 + 1)
        lr3 = Sheets("HMS").Cells(Rows.Count, "A").End(xlUp).Row
    End If
    Range("A140").Select
Next r
End Sub

我如何做到这一点？

Answer 1

首先是一个“好的做法”建议：总是告诉范围在哪个工作表中：

Range("C" & r).Value 
'becomes
Range("Place!C" & r).Value 
'or
sheets("Place").Range("C" & r).Value 

现在答案是：代码只是按照您的指示去做：

Rows(r).Copy Destination:=Sheets("Coke").Range("A" & lr2 + 1)

==> 您复制整行并将其放在 A 中。这将替换整行 如果你不需要格式，你应该使用这个：

range("Coke!A" & lr2 +1 & ":F" & lr2 +1 ) = range("Place!C" & r & ":H" & r).value2

如果您需要格式（较慢的代码）：

range("Place!C" & r & ":H" & r).copy  Destination:=Sheets("Coke").Range("A" & lr2 + 1)