使用宏將過濾的數據複製到另一個工作表

我有兩個工作表中的一個具有完整數據，另一個基於第一個工作表上應用的過濾器。使用宏將過濾的數據複製到另一個工作表

數據表的名稱：「數據」的過濾表的名稱：「Hoky」

我剛服用數據爲簡單起見一小部分。我的目標是根據過濾器複製數據表中的數據。我有一個宏，它以某種方式工作，但它的編碼，並且是一個錄製的宏。我的問題是， 1.行數每次都不一樣。（手動操作） 2.列沒有按順序排列。

下面是我的代碼和工作表的屏幕截圖。

Sub TESTTHIS() 
' 
' TESTTHIS Macro 
' 
'FILTER 
Range("F2").Select 
Selection.AutoFilter 
ActiveSheet.Range("$B$2:$F$12").AutoFilter Field:=5, Criteria1:="hockey" 

'Data Selection and Copy 
Range("C3").Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.Copy 
Sheets("Hockey").Select 
Range("E3").Select 
ActiveSheet.Paste 

Sheets("Data").Select 
Range("D3").Select 
Range(Selection, Selection.End(xlDown)).Select 
Application.CutCopyMode = False 
Selection.Copy 
Sheets("Hockey").Select 
Range("D3").Select 
ActiveSheet.Paste 

Sheets("Data").Select 
Range("E3").Select 
Range(Selection, Selection.End(xlDown)).Select 
Application.CutCopyMode = False 
Selection.Copy 
Sheets("Hockey").Select 
Range("C3").Select 
ActiveSheet.Paste 

End Sub

來源

2016-08-24 Ananya Pandey

-1

我建議你做它用不同的方式。

在下面的代碼我設定爲Range與體育名稱F和它loop through each cell列，檢查它是否是「曲棍球」，如果是的，我插入的值在另一片一個接一個，通過使用Offset 。

我不認爲它很複雜，即使你剛剛學習VBA，你也應該能夠理解每一步。請讓我知道如果你需要一些澄清

Sub TestThat() 

'Declare the variables 
Dim DataSh As Worksheet 
Dim HokySh As Worksheet 
Dim SportsRange As Range 
Dim rCell As Range 
Dim i As Long 

'Set the variables 
Set DataSh = ThisWorkbook.Sheets("Data") 
Set HokySh = ThisWorkbook.Sheets("Hoky") 

Set SportsRange = DataSh.Range(DataSh.Cells(3, 6), DataSh.Cells(Rows.Count, 6).End(xlUp)) 
    'I went from the cell row3/column6 (or F3) and go down until the last non empty cell 

    i = 2 

    For Each rCell In SportsRange 'loop through each cell in the range 

     If rCell = "hockey" Then 'check if the cell is equal to "hockey" 

      i = i + 1        'Row number (+1 everytime I found another "hockey") 
      HokySh.Cells(i, 2) = i - 2    'S No. 
      HokySh.Cells(i, 3) = rCell.Offset(0, -1) 'School 
      HokySh.Cells(i, 4) = rCell.Offset(0, -2) 'Background 
      HokySh.Cells(i, 5) = rCell.Offset(0, -3) 'Age 

     End If 

    Next rCell 

End Sub

來源

2016-08-24 14:30:15

它工作正常。謝謝。我知道了，儘管我必須更多地瞭解偏移函數。 –

這是一個非常耗時的過程，需要花費大量時間來讀取每一行並將其複製到另一個工作表，工作表將在您擁有數千條記錄中的數據時掛起 –

當我需要將數據從過濾表複製我使用range.SpecialCells（xlCellTypeVisible）.copy。範圍是所有數據的範圍（沒有過濾器）。

例子：

Sub copy() 
    'source worksheet 
    dim ws as Worksheet 
    set ws = Application.Worksheets("Data")' set you source worksheet here 
    dim data_end_row_number as Integer 
    data_end_row_number = ws.Range("B3").End(XlDown).Row.Number 
    'enable filter 
    ws.Range("B2:F2").AutoFilter Field:=2, Criteria1:="hockey", VisibleDropDown:=True 
    ws.Range("B3:F" & data_end_row_number).SpecialCells(xlCellTypeVisible).Copy 
    Application.Worksheets("Hoky").Range("B3").Paste 
    'You have to add headers to Hoky worksheet 
end sub

來源

2016-08-24 11:34:28 Marek

你能寫一個例子（完整的代碼），以便我可以將它應用到我的工作表上。 –

最好做

下面的代碼的方法是複製在DBExtract表可見數據，並將其粘貼到duplicateRecords片，只用過濾後的值。我選擇的範圍是我的數據可以佔用的最大範圍。您可以根據需要更改它。

Sub selectVisibleRange() 

    Dim DbExtract, DuplicateRecords As Worksheet 
    Set DbExtract = ThisWorkbook.Sheets("Export Worksheet") 
    Set DuplicateRecords = ThisWorkbook.Sheets("DuplicateRecords") 

    DbExtract.Range("A1:BF9999").SpecialCells(xlCellTypeVisible).Copy 
    DuplicateRecords.Cells(1, 1).PasteSpecial 


    End Sub

來源

2017-08-22 01:46:26

使用宏將過濾的數據複製到另一個工作表

回答

相關問題