Question

我有一个工作簿，其中包含具有相同结构的一些数据的多个工作表。我需要将过滤器应用于每个工作表中6月值的“销售”列。然后将筛选器数据复制到一张纸中的另一个工作簿。过滤数据源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

Answer 1

将复制和粘贴的逻辑更改为老式语法，并且效果很好。这是所需的代码行：

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

此Range("A" & LastRow)必须正确书写。

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

1 个答案: