いつもありがとうございます ＞各シートを挿入し 列の幅を指定するにはどうしたらいいのかわからない 教

いつもありがとうございます

＞各シートを挿入し
列の幅を指定するにはどうしたらいいのかわからない
教えてください


Sub Sample()
Dim ws As Worksheet
Dim rg As Range, c As Range, urg As Range
Dim msr As Long, mxc As Long
Const Dsht = "Data"
Const f = "=(COUNTIF(B$2:B2,B2)=1)*(COUNTIFS(B:B,B2,G:G,""未完了"")>0)"

Application.DisplayAlerts = False
For Each ws In Worksheets
　If ws.Name <> Dsht Then ws.Delete
Next ws
Application.DisplayAlerts = False

Set ws = Worksheets(Dsht)
mxc = Columns.Count
mxr = ws.Cells(Rows.Count, 2).End(xlUp).Row
If mxr < 2 Then Exit Sub

Set urg = ws.Cells(1, 1).Resize(mxr, 7)
Set rg = ws.Cells(2, mxc).Resize(mxr - 1)
rg.FormulaLocal = f

For Each c In rg
　If c.Value = 1 Then
　　With Worksheets.Add(after:=Worksheets(Worksheets.Count))
　　　.Name = ws.Cells(c.Row, 2).Text
　　　urg.AutoFilter
　　　urg.AutoFilter Field:=2, Criteria1:=ws.Cells(c.Row, 2).Text
　　　urg.AutoFilter Field:=7, Criteria1:="未完了"
　　　urg.Copy
　　　.Cells(1, 1).PasteSpecial Paste:=xlPasteValues
　　End With
　End If
Next c

urg.AutoFilter
ws.Columns(mxc).Delete
ws.Activate

End Sub

No.1 ベストアンサー 回答者： tatsu99 回答日時： 2019/10/19 17:32

.Cells(1, 1).PasteSpecial Paste:=xlPasteValues

を
.Cells(1, 1).PasteSpecial Paste:=xlPasteAll
にしてはいかがでしょうか。

この回答へのお礼

はい、なんとかいきました。
有難うございました。
もう一つおしえてくれませんでしょうか
同じ内容でもう一度質問します。
お時間があれば教えていただきたいことがあります

お礼日時：2019/10/19 21:28