使用宏将过滤的数据复制到另一个工作表

我有两个工作表中的一个具有完整数据，另一个基于第一个工作表上应用的过滤器。使用宏将过滤的数据复制到另一个工作表

数据表的名称：“数据” 的过滤表的名称：“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

使用宏将过滤的数据复制到另一个工作表

回答

相关问题