将所有先前过滤的数据从所有工作表复制到另一个工作表 [英] Copy all previously filtered data from all worksheets to another

问题描述

我有一本约63张的工作簿.我想从所有工作表中获取所有过滤后的数据(由宏过滤)，并将其粘贴到单独的工作表中.

I have a workbook with about 63 sheets. I'd like to take all filtered data (filtered by a macro) from all worksheets and paste them into a separate worksheet.

工作表没有相同的数据范围.如果所有数据都没有，那么它们都将从第15列A列开始.过滤器宏会针对其中一列中的特定值进行过滤，因此会区分每张工作表中的行.

Worksheets DON'T have the same data range. They all would start on Column A Row 15 IF there is any data there at all. The filter macro filters for specific values in one of the columns hence the differentiation between rows in each sheet.

我需要复制从范围A15开始的所有过滤数据，范围的最后一行将是AI.如果有任何行可以获取要复制的范围内的AI编号，那么只需几行即可.

I need to copy all filtered data starting with a Range of A15 and the last row in the range would be AI. It's just a matter of how many rows if there are any rows to get the number for the AI in the range to copy over.

我可以将整个工作表(而不是过滤后的数据)复制到另一工作表，而仅复制工作表1.

I got it to copy an entire sheet, not the filtered data, to another sheet but it only copied sheet 1.

Sub rangeToNew_Try2()
Dim newBook As Excel.Workbook
Dim rng As Excel.Range

Set newBook = Workbooks.Add

Set rng = ThisWorkbook.Worksheets("Sheet1").Cells.SpecialCells(xlCellTypeVisible)

rng.Copy newBook.Worksheets("Sheet1").Range("A1")
End Sub

推荐答案

您可以使用 Worksheet.UsedRange 仅提供包含数据的范围，然后可以应用 Range.SpecialsCells 为您提供过滤后的数据.

You can use Worksheet.UsedRange to give you just the Range with data in, then you could apply your Range.SpecialsCells to give you just the filtered data.

为帮助调试代码，请设置一个断点并使用立即窗口查看范围是什么，即:

To help debug your code, set a breakpoint and use the Immediate Window to see what the range is, i.e.:

?rng.Address

(问号会打印出下面的内容.)

(The question mark prints out whatever follows.)

此功能应满足您的需求:

This function should do what you need:

Sub CopyFilteredDataToNewWorkbook()

    Dim newBook As Excel.Workbook
    Dim rng As Excel.Range
    Dim sht As Excel.Worksheet
    Dim rowoffsetcount As Long
    Dim newsht As Excel.Worksheet

    Set newBook = Workbooks.Add

    ' ThisWorkbook.Worksheets is the same as the Sheets or Worksheets object, but more explicit
    For Each sht In ThisWorkbook.Worksheets

        ' Get the used rows and columns
        Set rng = sht.UsedRange

        ' Offset the range so it starts at row 15
        rowoffsetcount = 15 - rng.Row
        Set rng = rng.Offset(rowoffsetcount)

        ' Check there will be something to copy
        If (rng.Rows.Count - rowoffsetcount > 0) Then

            ' Reduce the number of rows in the range so it ends at the same row
            Set rng = rng.Resize(rng.Rows.Count - rowoffsetcount)

            ' Check that there is a sheet we can copy it to
            On Error Resume Next
            Set newsht = Nothing
            Set newsht = newBook.Worksheets(sht.Index)
            On Error GoTo 0

            ' We have run out of sheets, add another at the end
            If (newsht Is Nothing) Then
                Set newsht = newBook.Sheets.Add(, newBook.Worksheets(newBook.Worksheets.Count))
            End If

            ' Give it the same name
            newsht.Name = sht.Name

            ' Get the range of visible (i.e. unfiltered) rows
            ' (can't do this before the range resize as that doesn't work on disjoint ranges)
            Set rng = rng.SpecialCells(xlCellTypeVisible)

            ' Paste the visible data into the new sheet
            rng.Copy newsht.Range("A1")

        End If

    Next

End Sub

这篇关于将所有先前过滤的数据从所有工作表复制到另一个工作表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！