|    | 
     ▼ayu さん: 
 
もう1つ。 
転記レイアウトは アップ済みのものとはかえてあります。 
外部参照数式を使い、ブックを開かないタイプ。 
処理上もループをなくしてあります。 
元ブックのフォルダは、アップ済みのもの同様、マクロブックと同じフォルダにしてあります。 
 
Sub Sample2() 
  Dim fPath As String 
  Dim ref As String 
  Dim shT As Worksheet 
  Dim r As Range 
   
  fPath = ThisWorkbook.Path 
  ref = "='" & fPath & "\[元のブック.xlsx]該当のシート名'!" 
  Set shT = ThisWorkbook.Sheets("転記先のシート名") 
  shT.Cells.ClearContents   '転記前にクリア 
  shT.Range("A1:F1").Formula = ref & "A2" 
  shT.Range("A2:F2").Formula = ref & "A9" 
  shT.Range("A1:F2").Value = shT.Range("A1:F2").Value 
   
  With shT.Range("A2:F2") 
    .Replace 0, Empty, xlWhole 
    On Error Resume Next 
    .SpecialCells(xlCellTypeBlanks).EntireColumn.Delete 
    On Error GoTo 0 
  End With 
   
End Sub 
 | 
     
    
   |