スキルアップ・問題解決なら、モーグにおまかせ！

よろしくおねがいします。
 
陸上大会の集計表をマクロを使って自動化できないかと思いました。
 
事前に記録を記入するシートを配布し、記入後に送り返してもらう予定です。
大会は３０〜５０（従って返送されるブックも３０〜５０）ぐらいあり、
各大会の参加者人数もばらばらです。（各大会２００名程度までと予想しています）
 
構想としては、返送されたブックを１つのフォルダに入れて、
１ブックずつ開いて　カテゴリ１シートのＢ２４：Ｋ最終行　をコピーし、
集計ブック、カテゴリ１シートの　Ｂ６以降（５行目がタイトル行になっている)に貼り付けていくというイメージです。
そこで以下のようなコードを作りました。
---------------------------------------------------------------------
Private Sub CommandButton1_Click()
Dim bkSrc As Workbook 'コピー元ワークブック
Dim folderPath As String '処理対象のフォルダパス
Dim itm As Object
Dim LastRow1 As Long 'コピー元の最終行取得
Dim LastRow2 As Long '集計先の最終行取得
 
'Excel該当ファイルが保存されているフォルダを選択
With Application.FileDialog(msoFileDialogFolderPicker)
    .AllowMultiSelect = False '複数選択しない
    .Title = "Excelファイルが保存されているフォルダを選択"
    If .Show = True Then
        folderPath = .SelectedItems(1) '選択したフォルダのパスを変数に格納
    Else
        Exit Sub 'フォルダが選択されなかった場合は処理終了
    End If
End With
 
'ファイルの処理にFileSystemObjectオブジェクトを利用
With CreateObject("Scripting.FileSystemObject")
    '指定したフォルダ内のファイルを順番に処理
    For Each itm In .GetFolder(folderPath).Files
        '処理対象となるファイルの拡張子を指定
        Select Case LCase(.GetExtensionName(itm))
        Case "xls", "xlsx", "xlsm"
            Set bkSrc = Application.Workbooks.Open(itm.Path) '元のワークブックを開く
            LastRow1 = bkSrc.Worksheets("カテゴリ１").Range("B" & Rows.Count).End(xlUp).Row
            LastRow2 = ThisWorkbook.Worksheets("カテゴリ１").Range("B" & Rows.Count).End(xlUp).Row
            bkSrc.Worksheets("カテゴリ１").Range("B24:K" & LastRow1).Copy
            ThisWorkbook.Worksheets("カテゴリ１").Range("B" & LastRow2 + 1).PasteSpecial xlPasteValues
            bkSrc.Close SaveChanges:=False 'コピー元のワークブックを変更せずに閉じる
        End Select
    Next
End With
End Sub
-----------------------------------------------------------
ここで質問ですが、
１）動きがとてもユックリなので、もう少しきびきびさせる方法はないか？
２）「クリップボードに大きなデータが残っていますが残しますか、クリアしますか」のダイアログが出るので、表示せずに進めさせる方法はありますか？
 
コードは、ネットで見つけたものを組み合わせているのでおかしなところが多いと思いますが、
よろしくお願いします。、
 
 
 

感想
 
対象ブックを開くまでのコードが長い
　Getopenfilenameを使えば、数行で済みます。
これでどれだけ早くなるかはわかりませんが・・・
でもフォルダ検索が必要ならば、それほど変わらないか・・・
 
クリップボードの話は、
方法は２つ
 
方法１
貼付け後、
Application.CutCopymode = False
を実行すればよいでしょう。
 
方法２
そもそも、クリップボードを使わない方法
コードのイメージ
受け側セル範囲.Value = 送り側セル範囲.Value
 

Thisworkbookには、セルに数式が入っていますか？
若し、数式が入っていたら、再計算モードを手動に変更してください。

m024240 さんの引用:

１）動きがとてもユックリなので、もう少しきびきびさせる方法はないか？
２）「クリップボードに大きなデータが残っていますが残しますか、クリアしますか」のダイアログが出るので、表示せずに進めさせる方法はありますか？

   bkSrc.Worksheets("カテゴリ１").Range("B24:K" & LastRow1).Copy
   ThisWorkbook.Worksheets("カテゴリ１").Range("B" & LastRow2 + 1).PasteSpecial xlPasteValues

        With bkSrc.Worksheets("カテゴリ１").Range("B24:K" & LastRow1)
            ThisWorkbook.Worksheets("カテゴリ１").Range("B" & LastRow2 + 1). _
                    Resize(.Rows.Count, Columns.Count).Value = .Value
        End With

返信が遅くなりました。
ＰＣの不調でコードを修正するのが遅くなりました。
おまけに、まとめレスとなることをお許しください。
 
結論として、自分で満足のできるものになりました。
助言いただいた方、ありがとうございました。
 
 
WinArrow　様
 
>>Application.CutCopymode = False
 
>>Thisworkbookには、セルに数式が入っていますか？
>>若し、数式が入っていたら、再計算モードを手動に変更してください。
 
２点の助言ありがとうございました。
 
 
 
hatena　様
 
>>あと、処理の最初に、
>>Application.ScreenUpdating = False
>>処理に最後に
>>Application.ScreenUpdating = True
 
コードに入れました。
 
これをもって、解決済みとさせていただきます。