Vba 带条件的Excel宏复制粘贴

Vba 带条件的Excel宏复制粘贴,vba,excel,Vba,Excel,我在excel中有一个宏,它可以工作,但不是我想要的完美。无法找到解决方案,需要您的想法 它的作用是:从设置复制粘贴值到计算表中的第一个非空单元格。它可以 以下是我的代码: Sub support() Sheets("Settings").Select Range("S411:S421").Select Selection..Copy Sheets("Calculation").Select Range("C4").Select Range("C4").End(xlDown).Offset(1,

我在excel中有一个宏,它可以工作,但不是我想要的完美。无法找到解决方案,需要您的想法

它的作用是:从设置复制粘贴值到计算表中的第一个非空单元格。它可以

以下是我的代码:

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

但我只想将非空单元格和非0的值复制到这10行之间的计算页面。(所以我应该跳过复制0和空单元格)有什么简单的技巧可以指导我吗

是否每次都要从
范围(“S411:S421”)
复制到
范围(“C4”)…->
?或者这些范围可以改变

尝试:

公共子命令按钮1\u单击()
j=4
对于i=411到421
如果ThisWorkbook.Sheets(“设置”).Cells(i,19)0和ThisWorkbook.Sheets(“设置”).Cells(i,19)”,则
此工作簿.工作表(“设置”).单元格(i,19).复制
此工作簿.Sheets(“计算”).Cells(j,3).PasteSpecial(xlPasteValues)
j=j+1
如果结束
接下来我
端接头

您可以使用
AutoFilter()

子支持()

对于工作表(“设置”).Range(“S410:S421”)“是的,我希望每次都复制相同的单元格和范围,但不更改。但是在我经过它的地方改变的行。我复制的范围(“S411:S421”)包含公式,因此每次都有不同的值。是的,当你在范围S411:S421中有例如(10,0,-,0,-,45,78,96,0,-,121)时,你想在C4和以下有(10,45,78,96121),这是一个好主意,效果完美。我对自己很生气,我没有想到autofilter:(只是补充说,如果您确定S410单元格始终不是空的,那么您可以省略这两个
如果是空的(.Cells(1,1)),那么.Cells(1,1).Value=“dummyheader”
如果.Cells(1,1).Value=“dummyheader”那么.Cells(1,1).ClearContents
语句谢谢你很可能不会是空的,但不能确定。我会慢慢看,并记住这一点。再次感谢你。
    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
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