Question

您好我正在使用下面的代码将数据有条件地从一张工作表复制到工作簿中的其他工作表。每张纸都有不同的条件。如果工作表员工数据中的列AQ4为空白且列BA4包含文本为＆＃34;工作＆＃34;然后将该行的数据从工作表员工数据复制到工作表更新。对于工作表执行，如果列G4包含文本为＆＃34;执行＆＃34;和列BA4包含文本＆＃34;工作＆＃34;然后将该行的数据从工作表员工数据复制到工作表执行。对于工作表主管，如果列G4包含文本为＆＃34;主管＆＃34;和列BA4包含文本＆＃34;工作＆＃34;然后将该行的数据从工作表员工数据复制到工作表主管。对于工作表工作人员，如果列G4包含文本为＆＃34;工作人员＆＃34;和列BA4包含文本＆＃34;工作＆＃34;然后将该行的数据从工作表员工数据复制到工作表工作人员。对于已转移的工作表，如果列AQ为非空白，而列BA4包含文本为＆＃34;已转移＆＃34;然后将工作表员工数据中的数据复制到工作表中。

此代码既不工作也不显示任何错误。

Sub Main()
    Dim sh As Worksheet, str1 As Variant, str2 As Variant, shAry As Variant, c As Range, i As Long, rng As Range
    Set sh = Sheets("Employee Data")
    str1 = Array("", ",", "Executive", "Supervisor", "Workmen")
    str2 = Array("Working", "Transferred", "Working", "Working", "Working")
    shAry = Array("Updated", "Transferred", "Executive", "Supervisor", "Workmen")
    For i = LBound(str1) To UBound(str1)
        If i = 0 Or i = s1 Then
            Sheets(shAry(i)).Range("B4:AX20000").ClearContents
            With sh.UsedRange.Offset(2).Resize(sh.UsedRange.Rows.Count - 2)
                .AutoFilter 51, str2(i)
                .AutoFilter 41, str1(i)
            End With
        Else
            Sheets(shAry(i)).Range("B4:AX20000").ClearContents
            With sh.UsedRange.Offset(2).Resize(sh.UsedRange.Rows.Count - 2)
                .AutoFilter 51, str2(i)
                .AutoFilter 6, str1(i)
            End With
        End If
        Set rng = Intersect(sh.Range("B:AX"), sh.UsedRange.Offset(3)).Resize(sh.UsedRange.Rows.Count - 3)
        On Error Resume Next
        rng.SpecialCells(xlCellTypeVisible).Copy Sheets(shAry(i)).Cells(Rows.Count, 2).End(xlUp)(2)
        On Error GoTo 0
        sh.AutoFilterMode = False
    Next
End Sub

通过vba代码将数据从主工作表复制到工作簿中的其他工作表

0 个答案: