我有一个代码，只有在满足某些条件时才能将数据从一张表复制到另一张表。在此代码中，在复制数据之前删除数据的一部分工作正常，但第二部分即复制数据不起作用。代码如下： -
任何提示帮助都应该受到赞赏
Option Explicit
Sub Main()
Dim Rng As Range
Dim Cl As Range
Dim str1 As String
Dim str2 As String
Dim RowEmpCrnt As Long
Dim RowUpdCrnt As Long
Dim WshtEmp As Worksheet
Set WshtEmp = Sheets("Employee Data")
Set Rng = WshtEmp.UsedRange 'the range to search ie the used range
str1 = "" 'string1 to look for should be empty
str2 = "Working" 'string2 to look for should be empty
Sheets("Updated").Range("B4:AV20000").Value = ""
RowUpdCrnt = 1
For Each Cl In Rng.Columns("AK").Rows
If Cl.Text = str1 Then
RowEmpCrnt = Cl.Row
If WshtEmp.Cells(RowEmpCrnt, "AV").Value = str2 Then
' In my test data, the "Working"s are in column AV and blank cells are in column AK. This For-Each only selects column AV.
' If both column "AK" and column "AV" contain the correct value copy it to next empty row on sheet Updated
Cl.Range("B4:AV4").Copy Sheets("Updated").Range("B3").Cells(RowUpdCrnt, 1)
With WshtEmp.Rows(RowEmpCrnt)
Set Rng = Range(.Cells(2), .Cells(100)) ' range A:Z
End With
Rng.Copy Destination:=Sheets("Updated").Range("B3").Cells(RowUpdCrnt, 1)
RowUpdCrnt = RowUpdCrnt + 1
End If
End If
Next Cl
Set Rng = Sheets("Employee Data").UsedRange 'the range to search ie the used range
str1 = "," 'string1 to look for should be non empty
str2 = "Transferred" 'string2 to look for
Sheets("Transferred").Range("B4:AV20000").Value = ""
RowUpdCrnt = 1
For Each Cl In Rng.Columns("AK").Rows
If Cl.Text = str1 Then
RowEmpCrnt = Cl.Row
If WshtEmp.Cells(RowEmpCrnt, "AV").Value = str2 Then
' In my test data, the "Transferred"s are in column AV and blank cells are in column AK. This For-Each only selects column AV.
' If both column "AK" and column "AV" contain the correct value copy it to next empty row on sheet Transferred
Cl.Range("B4:AV4").Copy Sheets("Transferred").Range("B3").Cells(RowUpdCrnt, 1)
With WshtEmp.Rows(RowEmpCrnt)
Set Rng = Range(.Cells(2), .Cells(100)) ' range A:Z
End With
Rng.Copy Destination:=Sheets("Transferred").Range("B3").Cells(RowUpdCrnt, 1)
RowUpdCrnt = RowUpdCrnt + 1
End If
End If
Next Cl
Set Rng = Sheets("Employee Data").UsedRange 'the range to search ie the used range
str1 = "Executive" 'string1 to look for
str2 = "Working" 'string2 to look for
Sheets("Executive").Range("B4:AV20000").Value = ""
RowUpdCrnt = 1
For Each Cl In Rng.Columns("F").Rows
If Cl.Text = str1 Then
RowEmpCrnt = Cl.Row
If WshtEmp.Cells(RowEmpCrnt, "AV").Value = str2 Then
' In my test data, the "Executive"s are in column F and "Working"s are in column AV. This For-Each only selects column AV.
' If both column "F" and column "AV" contain the correct value copy it to next empty row on sheet Executive
Cl.Range("B4:AV4").Copy Sheets("Executive").Range("B3").Cells(RowUpdCrnt, 1)
With WshtEmp.Rows(RowEmpCrnt)
Set Rng = Range(.Cells(2), .Cells(100)) ' range A:Z
End With
Rng.Copy Destination:=Sheets("Executive").Range("B3").Cells(RowUpdCrnt, 1)
RowUpdCrnt = RowUpdCrnt + 1
End If
End If
Next Cl
Set Rng = Sheets("Employee Data").UsedRange 'the range to search ie the used range
str1 = "Supervisior" 'string1 to look for
str2 = "Working" 'string2 to look for
Sheets("Supervisior").Range("B4:AV20000").Value = ""
RowUpdCrnt = 1
For Each Cl In Rng.Columns("F").Rows
If Cl.Text = str1 Then
RowEmpCrnt = Cl.Row
If WshtEmp.Cells(RowEmpCrnt, "AV").Value = str2 Then
' In my test data, the "Supervisior"s are in column F and "Working"s are in column AV. This For-Each only selects column AV.
' If both column "F" and column "AV" contain the correct value copy it to next empty row on sheet Supervisior
Cl.Range("B4:AV4").Copy Sheets("Supervisior").Range("B3").Cells(RowUpdCrnt, 1)
With WshtEmp.Rows(RowEmpCrnt)
Set Rng = Range(.Cells(2), .Cells(100)) ' range A:Z
End With
Rng.Copy Destination:=Sheets("Supervisior").Range("B3").Cells(RowUpdCrnt, 1)
RowUpdCrnt = RowUpdCrnt + 1
End If
End If
Next Cl
Set Rng = Sheets("Employee Data").UsedRange 'the range to search ie the used range
str1 = "Workmen" 'string1 to look for
str2 = "Working" 'string2 to look for
Sheets("Workmen").Range("B4:AV20000").Value = ""
RowUpdCrnt = 1
For Each Cl In Rng.Columns("F").Rows
If Cl.Text = str1 Then
RowEmpCrnt = Cl.Row
If WshtEmp.Cells(RowEmpCrnt, "AV").Value = str2 Then
' In my test data, the "Workmen"s are in column F and "Working"s are in column AV. This For-Each only selects column AV.
' If both column "F" and column "AV" contain the correct value copy it to next empty row on sheet Supervisior
Cl.Range("B4:AV4").Copy Sheets("Workmen").Range("B3").Cells(RowUpdCrnt, 1)
With WshtEmp.Rows(RowEmpCrnt)
Set Rng = Range(.Cells(2), .Cells(100)) ' range A:Z
End With
Rng.Copy Destination:=Sheets("Workmen").Range("B3").Cells(RowUpdCrnt, 1)
RowUpdCrnt = RowUpdCrnt + 1
End If
End If
Next Cl
End Sub