|
Sub Test()
Dim WS As Worksheet, Sh As Worksheet
Dim MyR As Range
Set Sh = Worksheets("作業済")
Application.ScreenUpdating = False
For Each WS In Worksheets
Select Case WS.Name
Case "Sheet1", "Sheet2", "Sheet3", "作業済"
Case Else
Set MyR = WS.Range("F7", WS.Range("F65536").End(xlUp))
WS.Range("F6", WS.Range("F65536").End(xlUp)) _
.AutoFilter Field:=1, Criteria1:="100.0%"
On Error Resume Next
If IsEmpty(Sh.Range("A7").Value) Then
MyR.SpecialCells(12).EntireRow.Copy Sh.Range("A7")
Else
MyR.SpecialCells(12).EntireRow _
.Copy Sh.Range("A65536").End(xlUp).Offset(3)
End If
WS.AutoFilterMode = False
Set MyR = Nothing: Err.Clear
End Select
Next
Set Sh = Nothing
Application.ScreenUpdating = True
End Sub
で、どうでしょーか ?
|
|