AdvancedFilter CopyToRange：=第一个空行

我想在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

将您的高级filter行更改为：

 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