안녕하세요 한 시트에서 통합 문서의 여러 시트로 조건부로 데이터를 복사하는 코드가 있습니다. 이 코드는 대상 시트에 데이터를 복사하기 전에 대상 시트의 선택된 범위에있는 모든 데이터를 삭제합니다. 나를 위해이 부분은 잘 작동하지만 데이터를 삭제 한 후 코드는 대상 시트에 데이터를 붙여 넣지 않습니다. 또한 내가 비어 있지 않은 문자열을위한 코드를 ","로 설정했는지 모르겠습니다. 이 코드는 오류를 발생시키지 않으므로이를 정렬 할 수 없습니다. 코드는 다음과 같습니다 : -조건부로 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
범위 클래스의 오류 복사 메소드가 실패했습니다 .Column ("B4 : AV4") 시트 복사 ("업데이트 됨") 범위 ("B3") 셀 (RowUpdCrnt, 1) –
두 개의 사본이 있습니다. Cl.Range ("B4 : AV4") 및 Rng.Copy. 이 두 복사본 중 마지막 복사본은 이전 복사본을 전체 작업 범위로 덮어 씁니다. 거기에 두 번째 사본을 갖고 싶습니까? – Amorpheuses