Question

我正在尝试在VBA中使用AdvancedFilter，但我没有将复制范围设置为固定值，而是将其复制到第一个空行。

我试图从两个独立的AdvancedFilter步骤追加两个表，有更简单的方法吗？例如。首先将两个表复制到单独的位置然后合并它们？两个表都有相同的列。

截至目前我的代码是：

Set rngCriteria_v = Sheets("1").Range("filter")
     Set rngExtract_v = Sheets("2").Range("**Here first empty row**")
     Set rngData_v = Sheets("3").Range("Input")


     rngData_v.AdvancedFilter Action:=xlFilterCopy, _
                             CriteriaRange:=rngCriteria_v, _
                             CopyToRange:=Sheets("Stocks_5_control").Columns("AG").Find(vbNullString, Cells(Rows.Count, "AG")), _
                             Unique:=False

Answer 1

将高级过滤器行更改为：

rngData_v.AdvancedFilter xlFilterCopy, rngCriteria_v, Sheets("Stocks_5_control").Cells(Sheets("Stocks_5_control").Rows.Count, "AG").End(xlUp)(2)

Answer 2

以下内容将所有工作表合并到名为Master的新工作表中。希望有所帮助：）

Dim wrk As Workbook 'Workbook object - Always good to work with object variables
Dim sht As Worksheet 'Object for handling worksheets in loop
Dim trg As Worksheet 'Master Worksheet
Dim rng As Range 'Range object
Dim colCount As Integer 'Column count in tables in the worksheets
 Dim wd As Object 'used for word document
Dim WDoc As Object
Dim strWorkbookName As String
Set wrk = ActiveWorkbook 'Working in active workbook

For Each sht In wrk.Worksheets
    If sht.Name = "Master" Then
        MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _
        "Please remove or rename this worksheet since 'Master' would be" & _
        "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error"
        Exit Sub
    End If
Next sht




 'Add new worksheet as the last worksheet
Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
 'Rename the new worksheet
trg.Name = "Master"
 'Get column headers from the first worksheet
 'Column count first
Set sht = wrk.Worksheets(1)
colCount = sht.Cells(1, 255).End(xlToLeft).Column
 'Now retrieve headers, no copy&paste needed
With trg.Cells(1, 1).Resize(1, colCount)
    .Value = sht.Cells(1, 1).Resize(1, colCount).Value
     'Set font as bold
    .Font.Bold = True
End With

 'We can start loop
For Each sht In wrk.Worksheets
     'If worksheet in loop is the last one, stop execution (it is Master worksheet)
    If sht.Index = wrk.Worksheets.Count Then
        Exit For
    End If
     'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets
    Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount))
     'Put data into the Master worksheet
    trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Next sht
 'Fit the columns in Master worksheet
trg.Columns.AutoFit

AdvancedFilter CopyToRange：=第一个空行

2 个答案: