Question

以下是我用于将表格从“活动作业报告”复制到新工作表的代码，该工作表由人名称标记。它正在D列中查找人员姓名，然后将所有行复制到由该人员姓名标记的工作表中。这只适用于一个人，我目前只是复制并更改了其他工作表的名称。

我有9张不同的表（已订购的不同的人）将信息复制到。我有基本的VBA知识，所以我想知道是否有更有效的方法，或者我是否可以复制每个人名称的代码来复制行。看起来这个文件的运行速度非常慢。

我希望将所有这些绑定到当前的宏中，该宏将数据从软件数据库提取到excel中。如果不清楚，我会更新所需的信息。

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

' Shane Love
Set wsSource = Sheets("Active Job Report")     'Edit "Sheet1" to your source sheet name
Set wsDestin = Sheets("Shane Love")


Sheets("Shane Love").Cells.ClearContents

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

For Each rngCel In rngSource
    If rngCel.Value = "Shane Love" Then
        With wsDestin
            'Following line assumes column headers in Destination worksheet
            lngDestinRow = .Cells(.Rows.Count, "D").End(xlUp).Offset(1, 0).Row
            rngCel.EntireRow.Copy Destination:=wsDestin.Cells(lngDestinRow, "A")
        End With
    End If
Sheets("Shane Love").Select
Range("B1").Select
ActiveCell.FormulaR1C1 = "Due Date"
Range("C1").Select
ActiveCell.FormulaR1C1 = "Customer"
Range("D1").Select
ActiveCell.FormulaR1C1 = "Ordered By"
Range("E1").Select
ActiveCell.FormulaR1C1 = "Job #"
Range("F1").Select
ActiveCell.FormulaR1C1 = "Part Number"
Range("G1").Select
ActiveCell.FormulaR1C1 = "REV"
Range("H1").Select
ActiveCell.FormulaR1C1 = "Description"
Range("I1").Select
ActiveCell.FormulaR1C1 = "Make QTY"
Range("J1").Select
ActiveCell.FormulaR1C1 = "Trnsf QTY"
Range("k1").Select
ActiveCell.FormulaR1C1 = "Cmpltd QTY"
Range("L1").Select
ActiveCell.FormulaR1C1 = "FRR"
Range("M1").Select
ActiveCell.FormulaR1C1 = "Current Work Area"
Range("N1").Select
ActiveCell.FormulaR1C1 = "Current OP"
Range("O1").Select
ActiveCell.FormulaR1C1 = "Order Date"
Range("P1").Select
ActiveCell.FormulaR1C1 = "Priority"

Sheets("Shane Love").Select
Columns("Q:S").Select
Selection.EntireColumn.Hidden = True
'Columns("P:R").Select
'Selection.EntireColumn.Hidden = True

Worksheets("Shane Love").Range("B1:P1").AutoFilter
Worksheets("Shane Love").Columns("A:P").AutoFit


Next rngCel`

Answer 1

这项工作如何？我假设每张纸，除了＆＃34;活跃的工作报告＆＃34;是您要运行宏的工作表。

is_valid()

基于单元格值复制行减速excel

1 个答案: