Excel Makro kopieren einfügen mit Bedingungen

Question

Ich habe ein Makro in Excel, die funktioniert aber nicht perfekt, wie ich es will.Könnte keine Lösung finden und brauche Ihre Ideen.

Hier ist, was es ist: Kopieren von Einstellungen Paste Werte an die erste nicht leere Zelle in der Berechnung sheet.It tut ok

Hier wird die für dieses ist mein Code:

Sub support() 
Sheets("Settings").Select 
Range("S411:S421").Select 
Selection..Copy 
Sheets("Calculation").Select 
Range("C4").Select 
Range("C4").End(xlDown).Offset(1, 0).Select 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 
    :=False, Transpose:=False 
End Sub 

Aber was ich will um nur nicht leere Zellen und Werte, die nicht 0 sind, in die Berechnungsseite zwischen diesen 10 Zeilen zu kopieren. (also sollte ich das Kopieren von 0 und leeren Zellen überspringen) Jeder einfache Trick, den Sie mir leiten können?

Answer 1

könnten Sie AutoFilter() verwenden

Sub support() 
    With Sheets("Settings").Range("S410:S421") '<--| reference wanted range and the cell above it as the "header" 
     If IsEmpty(.Cells(1, 1)) Then .Cells(1, 1).Value = "dummyheader" '<--| add a "dummy" header value if it's empty 
     .AutoFilter Field:=1, Criteria1:="<>", Operator:=xlAnd, Criteria2:="<>0" '<--| filter referenced range with "not empty" and "not zero" values 
     If Application.WorksheetFunction.Subtotal(103, .Resize(, 1)) > 1 Then 
      .Resize(.Rows.Count - 1, 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy 
      Sheets("Calculation").Range("C4").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues 
      Application.CutCopyMode = False 
     End If 
     If .Cells(1, 1).Value = "dummyheader" Then .Cells(1, 1).ClearContents '<--| remove "dummy" header, if there 
     .Parent.AutoFilterMode = False 
    End With 
End Sub 

Answer 2

Möchten Sie von Range("S411:S421") zu Range("C4")..-> jedes Mal kopieren? Oder diese Bereiche können geändert werden?

TRY:

Public Sub CommandButton1_Click() 
j = 4 
For i = 411 To 421 

If ThisWorkbook.Sheets("Settings").Cells(i, 19) <> 0 And ThisWorkbook.Sheets("Settings").Cells(i, 19) <> "" Then 
ThisWorkbook.Sheets("Settings").Cells(i, 19).Copy 

ThisWorkbook.Sheets("Calculation").Cells(j, 3).PasteSpecial (xlPasteValues) 
j = j + 1 
End If 


Next i 
End Sub