[VBA]新しくXLSファイルを作成/出力を行う

新しくファイルを作成し、内容をコピーする必要があったので。

Sub outDataFile(ByVal fileName As String, ByVal range As Integer)
  Dim row As Integer
  Dim inWks, outWks As Object
  
  Set inWks = ActiveWorkbook
  Set outWks = CreateObject("Excel.Sheet")
  
  For shIdx = 1 To inWks.Worksheets.count
    If shIdx <> 1 Then outWks.Worksheets.Add after:=outWks.Worksheets(shIdx - 1)
    outWks.Worksheets(shIdx).Name = inWks.Worksheets(shIdx).Name
    
    row = 1
    Do
      For col = 1 To range
        outWks.Worksheets(shIdx).Cells(row, col) = inWks.Worksheets(shIdx).Cells(row, col)
      Next col
      
      row = row + 1
    Loop While inWks.Worksheets(shIdx).Cells(row, 1) <> ""
  Next shIdx
  
  outWks.SaveAs fileName
End Sub

ちょっとベンチマークとります
。