仅复制Excel中的可见数据条目,但出现问题,为什么?

时间:2018-03-14 20:12:42

标签: excel vba excel-vba

我希望创建一些VBA代码,在文件中的所有excel工作簿上复制两列仅可见数据。

例如,我可能看到这些数据(左边的数字是A列,右边是第2列):

  • 1 2
  • 1 3
  • 1 4
  • 1 5

但我使用的代码仅复制1 2用于此工作表,或者如果存在重复,则为

  • 1 2
  • 1 2
  • 1 3

然后复制第一个重复的值。我已经发布了我正在使用的代码。发生了什么事?

Sub MergeAllWorkbooks()
    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 = "This is my folder path"

    NRow = 1

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

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

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

        Set SourceRange = WorkBk.Worksheets(1).Range("B1:B100").SpecialCells(xlCellTypeVisible)

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

        DestRange.Value = SourceRange.Value

        NRow = NRow + DestRange.Rows.Count

        WorkBk.Close savechanges:=False

        FileName = Dir()
    Loop

    SummarySheet.Columns.AutoFit
End Sub

1 个答案:

答案 0 :(得分:0)

您需要在Range.Copy Method (Excel)

上使用xlCellTypeVisible

快速示例

Option Explicit
Public Sub Example()
    Dim SourceRange As Range
    Set SourceRange = ThisWorkbook.Worksheets(1).Range("B1:B100") _
                                                .SpecialCells(xlCellTypeVisible)

    Dim DestRange As Range
    Set DestRange = ThisWorkbook.Worksheets(2).Range("A1")

        SourceRange.Copy DestRange

End Sub