공통 헤더가있는 워크 시트에서 여러 데이터 검색 및 선택

Question

방금 ​​내 인생을 더 쉽게하기 위해 VBA를 사용하기 시작했습니다. 프로그래밍이 내 배경이 아닙니다. 코드를 실행할 때 너무 많이 쓸 수 있습니다. 두 가지 질문이 있으므로 아래 코드를 확인하십시오.

하위 나는 두 시트의 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