|
▼にしもり さん:
>▼Yuki さん:
>
最初に見出し行を貼り付けてからにしました。
変更して下さい。
With wb.Worksheets(2)
' 見出し行をコピー
.Rows("1:2").Copy ws.Range("A1")
shtName = .Name
Application.DisplayAlerts = False
.AutoFilterMode = False
With .Range("A1").CurrentRegion
.AutoFilter Field:=19, Criteria1:="=*協力*", _
Operator:=xlAnd, Criteria2:="<>*お断り*"
Set rng = .SpecialCells(xlCellTypeVisible)
' 行数が2行以上(1行目はタイトル)の時
If rng.Rows.Count > 1 _
Or rng.Areas.Count > 1 Then
' 見出し行とる
Set rng = .Offset(2).Resize(.Rows.Count - 2).SpecialCells(xlCellTypeVisible)
' 3行目に貼り付ける
rng.Copy ws.Range("A3")
'該当のシートを削除
wb.Worksheets(2).Delete
' 追加したシートをReName
ws.Name = shtName
Else
' 無かったらファイルを削除
MsgBox "None Data"
Application.DisplayAlerts = False
wb.Close False
' Application.Wait Now + TimeValue("0:00:01")
Kill varFnm
End If
End With
Application.DisplayAlerts = True
End With
|
|