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

'openin文件配合使用

    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)

VBA将自动筛选的数据复制到新工作簿中

2 个答案: