嗨,我有一个代码可以有条件地将数据从一张纸复制到工作簿中的多张纸上。此代码的工作方式为1.在将数据复制到目标工作表之前,它应删除目标工作表中所选范围内的所有数据。对我而言,这部分工作正常,但在删除数据后,代码不会粘贴目标工作表中的数据。此外,我已经设置非空字符串的代码为“,”,我不知道会不会起作用。此代码没有提供任何错误,所以我无法对此进行排序。代码如下: -有条件地使用vba代码将数据从一张纸复制到多张纸
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 = WshtEmp.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 = WshtEmp.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 = WshtEmp.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 = WshtEmp.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 = WshtEmp.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
它适用于我。使用','是好的。你确定你拼写正确的搜索字符串? – Amorpheuses
现在它给范围类的错误复制方法失败Cl.Range。( “B4:AV4”)的复印纸( “更新”)范围( “B3”)细胞(RowUpdCrnt,1) –
你有2个副本: Cl.Range(“B4:AV4”)和Rng.Copy。这两个副本中的最后一个覆盖整个工作范围的前一个副本。你确定你想要第二个副本吗? – Amorpheuses