Question

我已经编写了这段代码来尝试整理大量的Excel工作簿。通常，代码会获取工作簿中的所有数据，但我要求它只选择已经过滤并且现在可见的数据。听起来不错，对吗？不幸的是，它没有将所有数据保存到新工作簿中！例如，如果工作簿的单元格值为1,2900和2901已过滤且可见（3个可见行，但单元格引用可能为B1，B2000，B9999等），则代码将所有三行粘贴到复合工作簿中，然后使用序列中下一个工作簿中的数据保存最后两行！我想这与行号有关 - 我想我已经告诉代码选择所有突出显示的数据，但只创建了足够的行来保存它们。非常感谢任何帮助，谢谢大家。

Sub MergeDuplicatedDataFromWorkbooks()
Dim SummarySheet As Worksheet
Dim FolderPath As String
Dim NRow As Long
Dim FileName As String
Dim WorkBk As Workbook
Dim SourceRange As Range
Dim DestRange As Range

Set SummarySheet = Workbooks.Add(xlWBATWorksheet).Worksheets(1)

 FolderPath = "MY PATH"

NRow = 1

FileName = Dir(FolderPath & "*.xl*")

Do While FileName <> ""
    Set WorkBk = Workbooks.Open(FolderPath & FileName)

    SummarySheet.Range("A" & NRow).Value = FileName


 Set DestRange = SummarySheet.Range("B" & NRow)
  Set DestRange = DestRange.Resize(SourceRange.Rows.Count, _
   SourceRange.Columns.Count)

DestRange.Value = SourceRange.Value


    SourceRange.Copy DestRange

    NRow = NRow + DestRange.Rows.Count

 WorkBk.Close savechanges:=False

 FileName = Dir()
Loop

 End Sub

Answer 1

DestRange.Value = SourceRange.Value仅复制值。 SourceRange.Copy DestRange复制值和格式。无需使用两者。在这种情况下，建议使用.Copy来处理过滤器。使用.Resize类型的副本时需要.Value，现在可以省略它，因为.Copy为你做了，你需要做的就是指定目标范围的左上角单元格。试试这个：

SourceRange.SpecialCells(xlCellTypeVisible).Copy SummarySheet.Cells(NRow, 2)
NRow = Cells(NRow, 2).End(xlDown).Row + 1

尝试仅汇编来自多个工作簿的过滤数据

1 个答案: