Question

我正在尝试过滤两列：一列带有日期，另一列带有值（10及以下）。

我正在尝试将过滤后的值复制到另一个工作表中，但是似乎代码将复制整个列，而不仅仅是复制可见值。粘贴时显示错误“粘贴区域的大小不同”。我怎样才能解决这个问题？

下面是我的代码：

LastRow = btsvoice.Range("J" & btsvoice.Rows.Count).End(xlUp).Row
Set rng = btsvoice.Range("J2:J" & LastRow)

' filter and delete all but header row
With rng
    For Each lo In btsvoice.ListObjects
        lo.AutoFilter.ShowAllData
    Next lo

    On Error Resume Next
        .AutoFilter Field:=10, Criteria1:=">=" & Date - 3
        .AutoFilter Field:=35, Criteria1:="<11"
    On Error GoTo 0

    btsvoice.Range("I:I").SpecialCells(xlCellTypeVisible).Copy
    btsdata.Range("A5:A14").PasteSpecial xlPasteValues

End With

Answer 1

尝试这样的事情

'Variables
sheet1row1 = 1 'One cell above the start row number for the list of data you are interested in
sheet1column1 = 10 'The 1st column number of the data you are interested in
sheet1column2 = 35 'The 2nd column number of the data you are interested in

sheet2row1 = 1 'The row number on sheet 2 where the 1st set of data is to be displayed
sheet2row2 = 1 'The row number on sheet 2 where the 2nd set of data is to be displayed
sheet2column1 = 1 'The column number on sheet 2 for the 1st set of data
sheet2column2 = 2 'The column number on sheet 2 for the 2nd set of data

lastline = 100 'What ever the row value is of your last entry

Do
    'Increment the number of the cell to look at
    sheet1row1 = sheet1row1 + 1
    'Read the contents of the cell in the first column you are interested in
    cellvalue = Sheets("Sheet1").Cells(sheet1row1, sheet1column1).Value
    'Check if the value in the cell meets your required value
    If cellvalue >= Date - 3 Then
        'It meets your requirements so paste it to the second sheet
        Sheets("Sheet2").Cells(sheet2row1, sheet2column1).Value = cellvalue
        'Increment the paste position of the second sheet
        sheet2row1 = sheet2row1 + 1
    End If
    'Read the contents of the cell in the next column you are interested in
    cellvalue = Sheets("Sheet1").Cells(sheet1row1, sheet1column2).Value
    'Check if the value in the cell meets your required value
    If cellvalue < 11 Then
        'It meets your requirements so paste it to the second sheet
        Sheets("Sheet2").Cells(sheet2row2, sheet2column2).Value = cellvalue
        'Increment the paste position of the second sheet
        sheet2row2 = sheet2row2 + 1
    End If
Loop Until sheet1row1 > lastline

仅复制和粘贴具有值的单元格

1 个答案: