使用标准将数据从一个工作表复制到另一个工作表而不更改原始工作表

时间:2017-05-12 22:45:57

标签: excel vba excel-vba

我一直在研究VBA宏,将符合某些条件的数据从一个工作表复制到另一个工作表而不更改原始工作表。

我正在找到工作表“Prospects”中的最后一行并选择我需要的条件,然后将其复制到另一个工作表“Results”,但两个工作表看起来完全相同。

因此,任何不符合过滤条件的行都将从原始工作表“Prospects”中删除。

我需要原始工作表保持不变。我也只是捕获某些列,因此在“结果”工作表中隐藏了我不需要的列。

Sub ProspectList()

    Dim r As Range

    Dim ws As Worksheet

    Set ws = ActiveSheet

    ws.Range("A1").AutoFilter


    LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row
    LastCol = ActiveSheet.Cells(1, Columns.Count).End(xlUp).Column

    With Sheets("Prospect List").Range([A2], [A2].SpecialCells(xlCellTypeLastCell))
        ws.Range("A1").AutoFilter field:=13, Criteria1:="Pipeline"
        [B:B].EntireColumn.Hidden = True
        .Copy
        [C:C].EntireColumn.Hidden = True
        .Copy
        [E:E].EntireColumn.Hidden = True
        .Copy
        [H:H].EntireColumn.Hidden = True
        .Copy
        [I:I].EntireColumn.Hidden = True
        .Copy
        [K:K].EntireColumn.Hidden = True
        .Copy
        [L:L].EntireColumn.Hidden = True
        .Copy
        [B:B].EntireColumn.Hidden = False
        [C:C].EntireColumn.Hidden = False
        [E:E].EntireColumn.Hidden = False
        [H:H].EntireColumn.Hidden = False
        [I:I].EntireColumn.Hidden = False
        [K:K].EntireColumn.Hidden = False
        [L:L].EntireColumn.Hidden = False
    End With

    With Sheets("Results")
        If .Cells(Sheets(1).Rows.Count, 1).End(xlUp) = "" Then 'it's a clean sheet
            .Cells(Sheets(1).Rows.Count, 1).End(xlUp).PasteSpecial Paste:=xlPasteValues
        Else
            .Cells(Sheets(1).Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial Paste:=xlPasteValues
        End If
    End With
    Application.CutCopyMode = False

End Sub

2 个答案:

答案 0 :(得分:0)

第一:你的头衔令人困惑;你想过滤工作表上的数据"前景",复制可见数据,并将其移动到"结果"工作表? 第二:你" Dim r As Range"但是你不能在你的代码中使用它。 第三:你不要昏暗" LastRow"和#34; LastCol"并且甚至不在你的代码中使用它们。 第四:为什么要过滤" A栏和#34;然后"过滤列M"在隐藏特定列并且隐藏它们之前? 第五:你的" LastCol"代码错了 六:你没有明显的理由隐藏和取消隐藏列。 第七:你的"使用代码"没有任何意义,你正在测试" sheet1",而不是复制任何东西,然后粘贴" sheet1"不是"结果"片。哪个工作表是"表格(1)"? 我建议你过滤你的数据" Prospects"工作表使用.SpecialCells(xlCellTypeV‌​isible).Copy选择可见数据,然后粘贴到"结果"工作表

答案 1 :(得分:0)

这就是我最终要做的事情。

Sub ProspectList()

Dim ws As Worksheet Dim LastRow As Long

设置ws = ActiveSheet

'查找最后一行并将完整工作表复制到新工作表 LastRow = ActiveSheet.Cells(Rows.Count," A")。End(xlUp).row 表格("展望")。范​​围(" A1:M"& LastRow)。复制目的地:=表格("结果")。范​​围(" ; A1&#34) '设置新的"结果"表格激活
工作表("结果&#34)。激活

'filter by criteria and hide columns not needed
With Sheets("Results")
    ws.Range("A1").AutoFilter Field:=13, Criteria1:="Pipeline"

    [B:B].EntireColumn.Hidden = True
    [C:C].EntireColumn.Hidden = True
    [E:E].EntireColumn.Hidden = True
    [H:H].EntireColumn.Hidden = True
    [I:I].EntireColumn.Hidden = True
    [K:K].EntireColumn.Hidden = True
    [L:L].EntireColumn.Hidden = True
    [M:M].EntireColumn.Hidden = True
End With

Application.CutCopyMode = False

End Sub