列ヘッダー検索とワークシートループVBAでのパフォーマンスの向上

Question

「要約」タブに動的な列見出しがあり、ブックの最後に111のワークシートが追加されていますが、この数値は変更される可能性があります。追加された各ワークシートの各列ヘッダーを検索し、対応する列と行に一致する行の直下にセルをコピーします。これは、「要約」タブの追加されたワークシートごとに新しい行です。出力は私の期待に応えます。追加されたすべてのワークシートをループするのに必要な時間は必要ありません。コードを最適化したり、より効率的に目的の結果を達成する明白な方法があるかどうか教えてください。前もって感謝します。正接として

Sub riasummary() 
    Dim riawksht  As Worksheet 
    Dim consolwksht  As Worksheet 
    Dim c    As Integer 
    Dim r    As Long 
    Dim sheader   As Range 
    Dim sheaders  As Range 
    Dim rheader   As Range 
    Dim rheaders  As Range 

    c = Sheets("Summary").Cells(1, Columns.Count).End(xlToLeft).Column 
    Set sheaders = Sheets("Summary").Range(Cells(1, 1), Cells(1, c)) 

    For Each riawksht In ActiveWorkbook.Worksheets 
     If riawksht.Name <> "Summary" Then 
      Set rheaders = riawksht.Range("a5:xfd12") 
      For Each rheader In rheaders 
       For Each sheader In sheaders 
        r = Sheets("Summary").Cells(Rows.Count, "a").End(xlUp).Row 
        If rheader.Value = sheader.Value Then 
         rheader.Offset(1, 0).Copy 
         sheader.Offset(r, 0).PasteSpecial xlPasteAll 
         Application.CutCopyMode = False 
         'sheader.Offset(1, 0).Value = rheader.Offset(1, 0).Value 

        End If 

       Next 
      Next 
     End If 
    Next 

End Sub 

、私はまた、時折、私は解読することができないよう、次のコード行で、「アプリケーション定義またはオブジェクト定義エラー」を返し、ここで、任意の洞察は、はるかにも理解されるであろう。

Set sheaders = Sheets("Summary").Range(Cells(1, 1), Cells(1, c)) 

Answer 1

Set sheaders = Sheets("Summary").Range(Cells(1, 1), Cells(1, c)) 

であるべき：

With Sheets("Summary") 
    Set sheaders = Sheets("Summary").Range(.Cells(1, 1), .Cells(1, c)) 
End With 

彼らは、アクティブシートに（通常のモジュールに）デフォルト設定されますので、あなたは常に、非修飾CellsまたはRange呼び出しを避ける必要があります。