|
コードを貼り付け忘れたのでこちらに貼ります。
Sub Macro1()
Dim r1 As Long
Dim r2 As Long
Dim WS As Worksheet
r2 = Sheets("申請書未返送リスト(2005.10.01以降)").Range("B65536").End(xlUp).Row
Set WS = Sheets("申請書未返送リスト(2005.10.01以降)")
With Sheets("管理表マスター")
r1 = .Range("E65536").End(xlUp).Row
If r2 > 6 Then
Worksheets("申請書未返送リスト(2005.10.01以降)").Range("B5:K" & r1).ClearContents
End If
If .AutoFilterMode = False Then
.Range("B3:AE3").AutoFilter
End If
.Range("B3:AE" & r1).AutoFilter Field:=1, Criteria1:="製品出荷"
.Range("B3:AE" & r1).AutoFilter Field:=30, Criteria1:="="
.Range("B3:AE" & r1).AutoFilter Field:=10, Criteria1:=">2005/10/1", Operator:=xlAnd
.Range("B3:AE" & r1).AutoFilter Field:=12, Criteria1:="ユーザー"
.Range("B4:F" & r1).Copy
WS.Range("B5").PasteSpecial xlValues
.Range("H4:I" & r1).Copy
WS.Range("G5").PasteSpecial xlValues
.Range("K4:K" & r1).Copy
WS.Range("I5").PasteSpecial xlValues
.Range("N5:N" & r1).Copy
WS.Range("J5").PasteSpecial xlValues
.Range("W4:W" & r1).Copy
WS.Range("K5").PasteSpecial xlValues
WS.Application.CutCopyMode = False
.AutoFilterMode = False
End With
Set WS = Nothing
With Sheets("申請書未返送リスト(2005.10.01以降)").Range("B5:K" & r2)
.Sort Key1:=Range("G5"), Order1:=xlAscending, Header:=xlNo, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin, DataOption1:=xlSortNormal
End With
End Sub
|
|