Excel 我想将某些行数据项合并到一个选项卡中

Excel 我想将某些行数据项合并到一个选项卡中,excel,vba,Excel,Vba,我在工作中运行了一个审计,它可以返回数百万行数据项。所以excel为我提供了许多选项卡,每个选项卡上有65536行项目。我有一个vba代码,它会将所有数据合并到一个选项卡上,但由于每个选项卡的行限制,这同样不起作用。因此,我只希望某些行项目被拉出 我只想包括字段名为Position is use Time的行项目。我是VBA新手,并且假设我应该在循环中指定它 因此(在下面列出的代码中),每当字段名equals Position使用time时,我都需要将整个行项目放入新的审核跟踪选项卡中。我已经在

我在工作中运行了一个审计,它可以返回数百万行数据项。所以excel为我提供了许多选项卡,每个选项卡上有65536行项目。我有一个vba代码,它会将所有数据合并到一个选项卡上,但由于每个选项卡的行限制,这同样不起作用。因此,我只希望某些行项目被拉出

我只想包括字段名为Position is use Time的行项目。我是VBA新手,并且假设我应该在循环中指定它

因此(在下面列出的代码中),每当字段名equals Position使用time时,我都需要将整个行项目放入新的审核跟踪选项卡中。我已经在每个选项卡中包含了一个我正在寻找的行项目的示例,以及一个用于组合较小审计跟踪的代码副本

非常感谢您的帮助!多谢各位

我需要从数据中提取的行项目示例


Excel 2007取消了64K行限制。自从那个版本以来已经超过一百万行了。使用Power Pivot(XL 2010及更高版本),您可以将更多的行加载到数据模型中。用VBA循环处理所有这些数据将非常缓慢。使用Power Query等现代工具,可以组合所有工作表中的数据并设置过滤器。这将运行得更快。

您的Excel版本是什么?我正在使用2016,因此感谢您让我了解Power Pivot。那对我真的很有帮助。但是,对于这个特定的实例,我工作的审计员希望能够提取原始数据,然后能够运行VBA代码,以便提取所需的行项目,因为他们希望尽可能保持初始数据集不变。Power Query不会破坏初始数据集。您的审计跟踪将保持不变。您可以在完全独立的工作簿中执行电源查询/电源透视分析。如果您的审计员不了解Excel Power tools,他们应该提高技能。
Sub CopyFromWorksheets()
    Dim wrk As Workbook 'Workbook object 
    Dim sht As Worksheet 'Object for handling worksheets in loop
    Dim trg As Worksheet 'Audit Trail Worksheet
    Dim rng As Range 'Range object
    Dim colCount As Integer 'Column count in tables in the worksheets

    Set wrk = ActiveWorkbook 'Working in active workbook

     'Add new worksheet as the last worksheet
    Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count))
     'Rename the new worksheet
    trg.Name = "Audit Trail"

     'Get column headers from the first worksheet
     'Column count first
    Set sht = wrk.Worksheets(1)
    colCount = sht.Cells(1, 255).End(xlToLeft).Column

     'Retrieve Headers
    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

     '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 1st row as headers are only in first tab.
        Set rng = sht.Range(sht.Cells(1, 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

End Sub