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)

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

    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

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

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

Answer 2

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

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