|    | 
     ▼β さん: 
 
SampleCを使っての改良もしてみました。 
もっと早くなった気がします!! 
 
  j = 6 
  For x = 1 To 46 Step 5 
  Windows(exiWB).Activate 
  Worksheets("Sheet3").Activate 
  Sheets("Sheet3").Cells(ActiveCell.Row, x).Resize(, 4).Select 
  Selection.Copy 
  Windows(NewWB).Activate 
  Sheets("データ抽出").Range("B" & j).Resize(, 4).Select 
  Selection.PasteSpecial Paste:=xlValues 
  Windows(exiWB).Activate 
  Worksheets("Sheet3").Activate 
  Sheets("Sheet3").Cells(ActiveCell.Row, x + 4).Select 
  Selection.Copy 
  Windows(NewWB).Activate 
  Sheets("データ抽出").Range("H" & j).Select 
  Selection.PasteSpecial Paste:=xlValues 
  j = j + 5 
  Next 
 | 
     
    
   |