| 
    
     |  | こんにちは 
 Sheets("計画").Range("K:N").Copy
 .Range("E:H").PasteSpecial Paste:=xlPasteValues
 
 でコピーされたデータ部分の1〜2行目、セルE1:H2は空白になっていますか?
 .Range("E3").CurrentRegionに影響があります。
 
 また、
 Criteria1:=.Cells(10, i).Value
 は
 Criteria1:=.Cells(i, 10).Value
 ですね。
 
 Sub test()
 Dim aSh As Worksheet
 Dim i  As Integer
 
 Set aSh = Sheets("マクロセット")
 '#データ更新
 With aSh
 .Columns("E:J").Clear
 Sheets("計画").Range("K:N").Copy
 .Range("E:H").PasteSpecial Paste:=xlPasteValues
 Sheets("Data Base").Range("AP4:AP100").Copy
 .Range("J8").PasteSpecial Paste:=xlPasteValues
 
 .Range("E3:H3").AutoFilter
 
 If ActiveWorkbook.Worksheets.Count < 8 Then Exit Sub
 For i = 8 To ActiveWorkbook.Worksheets.Count
 .Range("$E$3:$H$5000").AutoFilter _
 Field:=4, Criteria1:=.Cells(i, 10).Value
 .Range("E3").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
 Sheets(i).Range("B53").PasteSpecial Paste:=xlPasteValues
 Next i
 End With
 
 End Sub
 
 |  |