时间戳

首页 > 解决方案 > 过滤多个工作表（同一工作簿）中的数据并复制另一个工作簿工作表中的数据

excel - 过滤多个工作表（同一工作簿）中的数据并复制另一个工作簿工作表中的数据

问题描述

我有一个工作簿，其中包含多个具有相同结构的数据的工作表。我需要对每张工作表中六月值的销售列应用过滤器。然后将过滤器数据复制到单个工作表中的另一个工作簿。过滤数据源 June.xlsm 工作簿中的第一个工作表，将过滤后的数据粘贴到 result.xlsx 工作簿中的名称工作表，然后过滤数据源 June.xlsm 中的第二个工作表，并将数据粘贴到 result.xlsx 的名称工作表中。我的代码在过滤和复制之前运行良好，但出现错误

粘贴线所需的对象ActiveSheet.Cells(Row.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues。

我知道我的逻辑缺少一点技巧，但几个小时后就无法弄清楚，这让我有点沮丧。请指导我克服它。问候

Sub FilterAll()

    Dim num As Integer
    Dim rngFound As Range
    Dim myCol As Long

    Dim wsData As Workbook
    Dim destData As Workbook
    Dim LastRow As Long
    Dim lastCol As Long
    Dim copyCol As Long
    Dim sPath As String

    Application.Workbooks("datasource JUNE.xlsm").Activate

    For Each Sheet In ActiveWorkbook.Sheets

        num = num + 1

        Sheet.Activate
        LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

        Set rngFound = ActiveSheet.Rows(1).Find(What:="", LookIn:=xlValues, LookAt:=xlWhole, _
                                                SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)

        lastCol = rngFound.Column - 1            ' this will give last used column: use in autofilter synatx

        Set rngFound = ActiveSheet.Rows(1).Find(What:="*Sales*", LookIn:=xlValues, LookAt:=xlWhole, _
                                                SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False)
        myCol = rngFound.Column

        ActiveSheet.Range(Cells(1, 1), Cells(LastRow, lastCol)).AutoFilter Field:=myCol, Criteria1:="*June*"

        Application.ActiveSheet.UsedRange.Offset(1, 0).Copy ' usedrange to select only used cells
        'Selection.Copy
        sPath = Application.ActiveWorkbook.Path
        Set destData = Workbooks.Open(sPath & "\result.xlsx")

        MsgBox "result opens"

        Application.Workbooks("result.xlsx").Worksheets("name").Activate
        MsgBox ActiveSheet.Name
        ActiveSheet.Cells(Row.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues

        Application.CutCopyMode = False


    Next

    MsgBox num

End Sub

标签： excelvba

解决方案

将复制和粘贴的逻辑更改为老式语法，它运行良好。这是所需的代码行：

Application.Workbooks("datasource JUNE.xlsm").ActiveSheet.UsedRange.Copy _
Destination:=Workbooks("result.xlsx").Worksheets(1).Range("A" & LastRow)

这Range("A" & LastRow)必须正确编写。

推荐阅读