Excel 将行范围复制到命名工作表

下面的代码将为a列中的每个单元格创建新的工作表。第二个模块将把a列中具有特定值的所有行复制到特定的目标

我创建了它，这样每个工单编号都有自己的工作表，所有带有该工单编号的行都复制到名为该工单编号的工作表中

问题是有604个唯一的工单编号，我必须为每个工单编辑第二个模块，以使其正常工作

是否有某种方法可以让它循环遍历A列中的所有值，并将其与设置变量进行比较，然后将行复制到具有该工单编号的工作表中？我不知道如何使目标表成为列A中的任何新值

我是VBA新手，所以这个问题可能没有多大意义。是的，我在一个模块中看到了基于每个新工作单创建和命名工作表的代码，但它通常不会编译，所以我将流程分为两个模块

无论如何，为了更好地理解我的意思：假设A列有4行工作单编号1234。我需要宏将1234的所有4行复制到名为1234的工作表中。然后转到下一个工作单编号。 它在其中检查工单的范围是A2:A39986，但整个范围是A2:F39986

谢谢你抽出时间

Option Explicit

Sub parse_data()
   Dim xRCount As Long
   Dim xSht As Worksheet
   Dim xNSht As Worksheet
   Dim I As Long
   Dim xTRow As Integer
   Dim xCol As New Collection
   Dim xTitle As String
   Dim xSUpdate As Boolean
   Set xSht = ActiveSheet
   On Error Resume Next
   xRCount = xSht.Cells(xSht.Rows.Count, 1).End(xlUp).Row
   xTitle = "A60:A604"
   xTRow = xSht.Range(xTitle).Cells(1).Row
   For I = 2 To xRCount
     Call xCol.Add(xSht.Cells(I, 1).Text, xSht.Cells(I, 1).Text)
   Next
   xSUpdate = Application.ScreenUpdating
   Application.ScreenUpdating = False
   For I = 1 To xCol.Count
      Call xSht.Range(xTitle).AutoFilter(1, CStr(xCol.Item(I)))
      Set xNSht = Nothing
      Set xNSht = Worksheets(CStr(xCol.Item(I)))
      If xNSht Is Nothing Then
         Set xNSht = Worksheets.Add(, Sheets(Sheets.Count))
         xNSht.Name = CStr(xCol.Item(I))
      Else
         xNSht.Move , Sheets(Sheets.Count)
      End If
      xSht.Range("A" & xTRow & xRCount).EntireRow.Copy xNSht.Range("A60")
      xNSht.Columns.AutoFit
    Next
    xSht.AutoFilterMode = False
    xSht.Activate
    Application.ScreenUpdating = xSUpdate


End Sub

以及将数据复制到特定目的地的模块：

    Sub CopyColumnOver()

    Dim wsSource As Worksheet
    Dim wsDestin As Worksheet
    Dim lngDestinRow As Long
    Dim rngSource As Range
    Dim rngCel As Range

    Set wsSource = Sheets("Sheet1")     'Edit "Sheet1" to your source sheet name
    Set wsDestin = Sheets("11556")

    With wsSource
        'Following line assumes column headers in Source worksheet so starts at row2
        Set rngSource = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
    End With

    For Each rngCel In rngSource
        If rngCel.Value = "11556" Then
            With wsDestin
                'Following line assumes column headers in Destination worksheet
                lngDestinRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
                rngCel.EntireRow.Copy Destination:=wsDestin.Cells(lngDestinRow, "A")
            End With
        End If
    Next rngCel

End Sub

---

将找到的值作为参数传递给正在复制到新工作表的子对象，并将其放入

sheets（）

。您需要检查工作表是否存在，如果不存在，则创建它。您正在工作簿中创建600多张工作表，从一张工作表复制数据？？？为什么？你想达到什么目标？一定有更好的方法。我将根据每个工单对数据进行分析，所以将所有数据分离出来是很重要的。我必须汇总操作，计算平均完成时间，然后将结果插入最终报告。