Excel-Makro - kopieren Sie Zellen von einem Blatt in ein anderes basierend auf Wert

Question

Ich möchte Zellen aus einem Blatt in ein anderes kopieren basierend auf Werte in einer Spalte. Das Problem ist, ich möchte die Werte und nicht die Formeln kopieren, aber ich kann nicht den Zielbefehl mit Passpecial arbeiten. Bisher habe ich:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _ 
Cancel As Boolean) 

Dim i, LastRow 

LastRow = Range("A" & Rows.Count).End(xlUp).Row 

Sheets("Available").Cells.ClearContents 

For Each c In Range("A1:A" & LastRow) 

If UCase(c.Offset(0, 1).Value) = "Not Sold" Then 

Range("A" & c.Row & ":" & "G" & c.Row).Copy _ 

Destination:=Sheets("Available").Range("A" & Rows.Count) _ 

.End(xlUp).Offset(1) 

End If 

Next c 

Target.Offset(1).Select 
End Sub 

ich auch mit dem Wert einige Zellen über der Zelle kopieren wollen und es auf der rechten Seite der Zeile in das neue Blatt kopiert hinzuzufügen.

Jede Hilfe würde wirklich geschätzt werden.

Answer 1

Lassen Sie mich zuerst auf ein paar Dinge hinweisen, von denen ich glaube, dass sie nicht funktionieren, oder eine gute Idee.

Die Verwendung von If UCase(c.Offset(0, 1).Value) = "Not Sold" sollte jedes Mal fehlschlagen, da Sie in Großbuchstaben konvertieren und dann vergleichen. Sie wollen If Ucase(c.Offset(0, 1).Value) = "NOT SOLD"

Zweitens Sie Einrichtung i und LastRow als Variants, statt Integers, was ich glaube, ist, was Sie wollen. Technisch kein Problem, aber ich mag unbekannte Variablen nicht. Sie scheinen auch nicht i zu verwenden, außer wenn ich etwas übersehen habe.

schließlich die letzte Zeile genau zu finden, die ich

lastRow = Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).row 

Dies ist die zuverlässigste Methode der Suche nach der letzten Zeile, die ich kenne, und tatsächlich found right here on stack.

Nun, für die Verwendung würde tatsächlichen Code selbst, hier ist meine Empfehlung.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _ Cancel As Boolean) 

    Dim i, LastRow as Integer 
    Dim ws1 As Worksheet 
    Dim ws2 As Worksheet 
    Set ws1 = ActiveSheet 
    Set ws2 = Sheets("Available") 

    i = 1 

    LastRow = ws1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row 

    ws2.Cells.ClearContents 

    For Each c In Range(Cells(1,2), Cells(LastRow, 2)) 
     If UCase(c.Value) = "NOT SOLD" Then 
      ws2.Range(ws2.Cells(i, 1), ws2.Cells(i, 7)).Value = ws1.Range(_ 
       ws1.Cells(c.Row, 1), ws1.Cells(c.Row, 7)).Value 
      i = i + 1 
     End If 
    Next c 

    Target.Offset(1).Select 

End Sub