2015-10-16 95 views
0

我想在VBA中使用AdvancedFilter,但不是將副本設置爲範圍爲固定值,我想將其複製到第一個空行。AdvancedFilter CopyToRange:=第一個空行

我想從兩個單獨的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 
+0

因此,要獲得這一直,你想合併兩個過濾工作表,在一個新的合併工作表?還是他們在單獨的工作簿? – Calum

+0

他們在同一個工作表和工作簿 – user3614882

回答

1

的先進過濾器行改成這樣:

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

謝謝,但這給了我:'VBA運行時錯誤1004「應用程序定義或對象定義的錯誤'我認爲它不會移動到'AG'的第一個空行 – user3614882

+0

這應該肯定移動到第一個空行。但它可能是別的。有沒有機會給我發送工作簿?我可以很快把它整理出來。我的電子郵件地址是:[email protected] –

+1

這不會解決錯誤問題,但我認爲在'(xlUp)'之後需要'.Offset(1)'才能到達下一個空行。 'End(xlUp)'會把你放在最後一行的數據。 –

0

下合併的所有工作表中一個叫做掌握新表。希望有所幫助:)

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