vba　転記 　高速化したい

Private Sub CommandButton1_Click()

'_________________________変数の宣言１'_________________________

'フォルダの場所を変数に入れる
    Dim Folder_path
    Folder_path = ThisWorkbook.Path & "\保存データ"
'集計するブックを変数に入れる
    Dim ImportWorkbook
    ImportWorkbook = Dir(Folder_path & "\*サブ*.xlsx")

  Dim startTime As Double
  Dim endTime As Double
  Dim processTime As Double





'_________________________コピペ処理の実行'_________________________


'開始時間取得
  startTime = Timer

'指定したフォルダから、Excelファイルを探す
Application.ScreenUpdating = False              '画面の描画更新を停止する

    Do Until ImportWorkbook = ""
        Workbooks.Open filename:=Folder_path & "\" & ImportWorkbook

        Dim ImportWorkbook_data  '集計するブック内のシートのデータ数
        Dim ThisWorkbook_data  '集計先のシートのデータ数

        Dim WO, PJ, Process, Bed As String




             'ベット作業用

            ThisWorkbook_data = ThisWorkbook.Worksheets("CT2").Range("a" & Rows.Count).End(xlUp).Row



             'Bed
            Bed = Workbooks(ImportWorkbook).Worksheets("ベット作業用").Range("C5")
            ThisWorkbook.Worksheets("CT2").Range("d" & ThisWorkbook_data + 1) = Bed





'            閉じる
            '集計するブックを
        Application.DisplayAlerts = False
            Workbooks(ImportWorkbook).Close
        Application.DisplayAlerts = True

'次のファイルを探しに行く
        ImportWorkbook = Dir()
    Loop


Application.ScreenUpdating = True                  '画面の描画更新を有効にする

'終了時間取得
  endTime = Timer

  '処理時間表示
  processTime = endTime - startTime
  MsgBox "処理時間：" & processTime



End Sub

def greet
  puts Hello World
end