VBA 将自动过滤的数据复制到新工作簿中

Question

以下是我的代码，我遇到了问题。从不同的工作簿中，我需要在新工作簿中创建 3 个新工作表。在一个中，我必须根据另一个工作簿中的工作表名称过滤数据。我坚持将过滤后的数据复制到新工作簿。在此之前一切正常。

    Sub Click()
    Dim xRow As Long
    Dim wbnew, wb1, wb2, wb3, wb4 As Workbook
    Dim sht, Data As Worksheet
    Dim sh1, sh2, Filter As String
    Dim Name As String
    Dim rng As Range

'打开要使用的文件

    Workbooks.Open filename:="C:\Users\File1.xlsx", ReadOnly:=True
    Workbooks.Open filename:="C:\Users\File2.xlsx", ReadOnly:=True
    Workbooks.Open filename:="C:\Users\File3.xlsx", ReadOnly:=True
    Workbooks.Open filename:="C:\Users\File4.xlsx", ReadOnly:=True

    wb1 = "File1.xlsx"
    wb2 = "File2.xlsx"
    Set wb3 = Workbooks("File3.xlsx")

'这里我创建一个临时文件

    Set wbnew = Workbooks.Add
    ActiveSheet.Name = "Data"

'定义我将使用的列

    sh1 = wb3.ActiveSheet.Range("A" & i).Value
    sh2 = wb3.ActiveSheet.Range("B" & i).Value
    Name = wb3.ActiveSheet.Range("F" & i).Value
    Filter = wb3.ActiveSheet.Range("C" & i).Value

'主要目标是将数据从 3 个不同的文件复制到新工作簿。下面从复制数据开始

    Workbooks(wb1).Worksheets(sh1).Copy _
    Before:=wbnew.Sheets(1)
    Workbooks(wb2).Worksheets(sh2).Copy _
    Before:=wbnew.Sheets(2)

'从第三个文件中，我必须使用上面定义的 File3.xlsx 中的条件自动过滤 File4.xlsx 中 U 列的数据

    Set wb4 = Workbooks("File4.xlsx")
    wb4.Activate
    xRow = wb4.Worksheets("Transactions").Range("A1").End(xlDown).Row
    wb4.Worksheets("Transactions").AutoFilterMode = False

    wb4.Worksheets("Transactions").Range("A:U").AutoFilter Field:=21, Criteria1:=Filter, Operator:=xlFilterValues

'尝试将结果从自动过滤器复制到新工作簿以获得 3 张新工作表，但出现错误，我也尝试了范围复制但没有成功

    Workbooks(wb4).ActiveSheet.Range("A1:U" & xRow).SpecialCells(xlCellTypeVisible).Copy _
    Destination:=wbnew.Sheets("Data")

    wb4.Worksheets("Transactions").AutoFilterMode = False
    End Sub

感谢您的建议。谢谢你

Answer 1

（写在我的手机上，可能有错别字）：使用高级过滤器：-

Sub Click()
    Dim xRow As Long
    Dim wb1 As Workbook, wb2 As Workbook, wb3 As Workbook, wb4 As Workbook, wbNew as workbook
    Dim sht as worksheet, Data As Worksheet
    Dim sh1 as string, sh2 as string, Filter As String
    Dim Name As String
    Dim rng As Range
'openin files to work with

   set wb1 =  Workbooks.Open(filename:="C:\Users\File1.xlsx", ReadOnly:=True)
    set wb2 = Workbooks.Open(filename:="C:\Users\File2.xlsx", ReadOnly:=True)
    set wb3 = Workbooks.Open(filename:="C:\Users\File3.xlsx", ReadOnly:=True)
   set wb4 = Workbooks.Open(filename:="C:\Users\File4.xlsx", ReadOnly:=True_
  set wbNew = workbooks.add()
   dim i as long 'this was missing
   i = 1 'what should this be?

'defining columns I will work with
with wb3.Sheets(1)
    sh1 = .Range("A" & i).Value
    sh2 = .Range("B" & i).Value
    Name = .Range("F" & i).Value
    Filter = .Range("C" & i).Value
end with
wb3.close false
'main goal is to copy data from 3 different files to new workbook. Below starting with copying data

    wb1.Worksheets(sh1).Copy Before:=wbnew.Sheets(1)
    wb1.close false
    wb2.Worksheets(sh2).Copy  before:=wbnew.Sheets(2)
    wb2.close false
'from third file I have to autofilter data for column U in File4.xlsx with criteria from File3.xlsx defined above


   with  wb4.Worksheets("Transactions")
            xRow =.Range("A1").End(xlDown).Row
          .range("Z1") = .range("U1")  'I assume Z is clear - insert heading
          .range("Z2") = filter        'insert value
           .range("a1:u1").copy wbnew.sheets("Data").range("a1")  'copy headings
          .range("a1:u" & xrow).AdvancedFilter _
          Action:=xlFilterCopy, _
          CriteriaRange:=.range(2z1:z2"), _
          CopyToRange:=wbnew.Sheets("Data").range("A1:u1")

    End With

    End Sub

Answer 2

你需要为你的目的地指定一个范围：

Workbooks(wb4).ActiveSheet.Range("A1:U" & xRow).SpecialCells(xlCellTypeVisible).Copy _
Destination:=wbnew.Sheets("Data").Range("A1:U" & xRow)