Worksheets w/common headerで複数のデータを検索して選択する

Question

私は人生を楽にするためにVBAを使い始めました。プログラミングは私のバックグラウンドではありません。私がコードを実行すると、あまりにも多く書くことがあります。 2つの質問がありますので、以下のコードを確認してください。

サブ私は両方のシートでforecast_quarterを見つけることができるようにしたいL.NAM.O

Worksheets("LAC").Select 
Cells.Select 
Selection.Find(What:="forecast_quarter", After:=ActiveCell, LookIn:= _ 
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _ 
    xlNext, MatchCase:=False, SearchFormat:=False).Activate 
Range("A2").Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.Copy 
Sheets("NewForecast").Select 
Range("K2").Select 
ActiveSheet.Paste 

'L.NAM.M 

Worksheets("EMEA").Select 
Cells.Select 
Selection.Find(What:="forecast_quarter", After:=ActiveCell, LookIn:= _ 
    xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _ 
    xlNext, MatchCase:=False, SearchFormat:=False).Activate 
Range("A2").Select 
Range(Selection, Selection.End(xlDown)).Select 
Selection.Copy 
Sheets("NewForecast").Select 
Range("K" & Rows.Count).End(xlUp).Offset(1).Select 
ActiveSheet.Paste 

'

' 」（私が持っている（） は ' ' マクロ探します3つのワークシート（新しい予測）に貼り付けてください。事は、これはあまりにも多く、すべてのプロセスを全面的に実行するより簡単な方法かもしれないと思います。

私の考えは、「私が望み、他の下に貼り付けるワークシートのforecast_quarter四半期を検索する」ことです。これを行うためのすべての基準があるので、これは私にとって大変なことです。 ありがとう！このような

Answer 1

サムシング（未テスト）動作するはずです。

Sub CopyAll() 

    CopyDataByHeader "LAC", "forecast_quarter" 
    CopyDataByHeader "EMEA", "forecast_quarter" 

End Sub 

'Look for a specific header on a sheet, and if found copy 
' the data below it to "NewForecast" sheet 
Sub CopyDataByHeader(shtName As String, hdrText As String) 

    Dim f As Range 

    With ActiveWorkbook.Sheets(shtName) 
     'search for the header 
     Set f = .Cells.Find(What:=hdrText, After:=.Cells(1), _ 
       LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, _ 
       SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) 

     If Not f Is Nothing Then 
      'found the header: copy the data below it 
      .Range(f.Offset(1, 0), .Cells(.Rows.Count, f.Column).End(xlUp)).Copy _ 
       ActiveWorkbook.Sheets("NewForecast").Cells(_ 
            Rows.Count, "K").End(xlUp).Offset(1, 0) 
     Else 
      'header not found... 
      MsgBox "Header text '" & hdrText & "' not found on sheet '" & shtName & "' !" 
     End If 

    End With 

End Sub