Excel VBA按钮。将行从Sheet1复制到Sheet2/condition：column value

Question

我使用下面的代码将行从Sheet1复制到SHEET2。我有三个问题。

1. 为什么这个函数总是复制行A2？即使值为“0”。
2. 如何只复制值，不复制格式？
3. 复制时是否可以跳过B栏？Sheet1中的“C”将在Sheet2中为“B”，等等。

Sub COPY_SA()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng As Range, rngToCopy As Range
Dim lastrow As Long
'change Sheets to suit
Set ws1 = ThisWorkbook.Worksheets("SA")
Set ws2 = ThisWorkbook.Worksheets("JC_input")

With ws1
    'assumung that your data stored in column A:D, Sheet1
    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set rng = .Range("A2:D" & lastrow)
    'clear all filters
    .AutoFilterMode = False
    With rng
        'apply filter
        .AutoFilter Field:=4, Criteria1:=">0"
        On Error Resume Next
        'get only visible rows
        Set rngToCopy = .SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
    End With
    'copy range
    If Not rngToCopy Is Nothing Then rngToCopy.CopyDestination:=ws2.Range("A2")
    'clear all filters
    .AutoFilterMode = False
End With
Application.CutCopyMode = False End Sub

我设法修改如下。工作表“WS1”中的范围仍然存在问题。无法在第二行设置筛选器并从第3行复制范围。这就是为什么添加：“ws2.rows(3).delete”。代码始终复制第1行。第1行得到了一些评论。第2行得到列名。

Sub COPY_SA()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng As Range, rngToCopy As Range
Dim lastrow As Long
'change Sheets to suit
Set ws1 = ThisWorkbook.Worksheets("SA")
Set ws2 = ThisWorkbook.Worksheets("JC_input")

With ws1
    'assumung that data stored in column C:E, Sheet1
    lastrow = .Cells(.Rows.Count, "C").End(xlUp).Row
    'can not make range from row 3 ???
    Set rng = .Range("C1:E" & lastrow)
    'clear all filters
    .AutoFilterMode = False
    With rng
        'apply filter with criteria in column 3 of range C:E
        'can not make filter in row 2 ???
        .AutoFilter Field:=3, Criteria1:=">0"
        On Error Resume Next
        'get only visible rows
        Set rngToCopy = .SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
    End With
    'copy range
    If Not rngToCopy Is Nothing Then rngToCopy.Range("A:C").Copy
    'paste from row 3
    ws2.Range("A3").PasteSpecial Paste:=xlValues
    'delete no needed row
    ws2.Rows(3).Delete
    'clear all filters
    .AutoFilterMode = False
    End With
Application.CutCopyMode = False
  If Not ActiveSheet.AutoFilterMode Then
    ws1.Range("2:2").AutoFilter
    End If
End Sub

Answer 1

假设两个工作表的标题都在第一行，请尝试此快速修复方法：

Sub COPY_SA()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim rng As Range, rngToCopy As Range
Dim lastrow As Long
'change Sheets to suit
Set ws1 = ThisWorkbook.Worksheets("SA")
Set ws2 = ThisWorkbook.Worksheets("JC_input")

With ws1
    'assumung that your data stored in column A:D, Sheet1
    lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set rng = .Range("A1:D" & lastrow)
    'clear all filters
    .AutoFilterMode = False
    With rng
        'apply filter
        .AutoFilter Field:=4, Criteria1:=">0"
        On Error Resume Next
        'get only visible rows
        Set rngToCopy = .SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
    End With
    'copy range
    If Not rngToCopy Is Nothing Then rngToCopy.Range("A:A,C:D").Copy
    ws2.Range("A1").PasteSpecial Paste:=xlValues
    'clear all filters
    .AutoFilterMode = False
End With
Application.CutCopyMode = False

End Sub

来回答你的问题：

1. 为什么这个函数总是复制行A2？即使值为“0”。