こんにちは、1枚のシートから複数枚のシートに条件付きでデータをコピーするコードがあります。このコードは、宛先シートにデータをコピーする前に、宛先シートの選択範囲内のすべてのデータを削除します。私にとってはこの部分はうまくいきましたが、データを削除した後、コードは宛先シートにデータを貼り付けていません。また、空でない文字列のコードを "、"として設定しています。これは動作しないかどうかわかりません。このコードはエラーを出さないので、これを並べ替えることはできません。コードは次のとおりです: -vbaコードを使用して1枚のシートから複数のシートに条件付きコピーする
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。これらの2つのコピーの最後は、前のコピーを作業範囲全体で上書きします。そこに2番目のコピーが必要ですか? – Amorpheuses