Kopiere bestimmte Daten (nicht die gesamte Zeile!) In ein anderes Blatt basierend auf dem Zellenwert

Question

Ich versuche, Zellendaten basierend auf einer Übereinstimmung von einem Blatt in ein anderes zu kopieren.

Ich habe eine Arbeitsmappe mit 3 Blättern. "Place", "Cola" und "HMS".

Am aktiven Blatt "Place", Wenn Spalte C14 das Wort "Cola" hat - ich möchte D14-H14 auf das Blatt "Cola" kopiert werden.

Ebenso, wenn C15 enthält „HMS“ - ​​ich nur „D15-H15“ auf das Blatt „HMS“

Ich habe ein Makro kopiert werden soll, dass die Kopien die gesamte Zeile, während ich bestimmte Zellen kopiert werden sollen - die aus ist das spezifische 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 

Kann ich das erreichen?

Answer 1

Erstens eine „gute Praxis“ Vorschlag: immer sagen, welches Blatt der Bereich in ist:

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

nun die Antwort: der Code nur tut, was Sie es gesagt, zu tun:

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

==> du kopierst die ganze Zeile und lege sie in A ab. Das ersetzt die ganze Zeile. Wenn du kein Format brauchst, solltest du folgendes verwenden:

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

wenn Sie Format (langsamer Code):

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