다른 범위의 행 번호에 따라 범위에 값 추가

Question

주어진 열 (G)의 각 행 값을 기반으로 목록을 생성하는 방법을 연구 중입니다. 현재 목록은 전체 행을 복사하고 완벽하게 작동합니다. G 열에 필요한 텍스트 ("카드")가 들어 있고 틈이없는 다른 스프레드 시트의 목록에 해당 열을 넣으면 모든 행을 가져옵니다.

문제는 목록에 전체 행이 아닌 "카드"가 들어있는 각 행의 정보가 일부만 포함되도록하려는 것입니다.

내 매크로가 "A", "G"및 "ET"열의 정보 만 가져올 수있는 방법이 있습니까?

내가 현재 사용하고있는 코드는 다음과 같습니다 :

이

'----Alonso Approved List Generator----' 
Sub AlonsoApprovedList() 
    Dim cell As Range 
    Dim NewRange As Range 
    Dim MyCount As Long 
    Dim ExistCount As Long 
    ExistCount = 0 
    MyCount = 1 
'----For every cell in row G on the ESI Project Data sheet----' 
    For Each cell In Worksheets("ESI Project Data").Range("G6:G5000") 
    If cell.Value = "Card" Then 
     ExistCount = ExistCount + 1 
     If MyCount = 1 Then Set NewRange = cell.Offset(0, -1) 
     '----Sets up a new range to copy all data from the row if column G in that row contains the value in question----' 
     Set NewRange = Application.Union(NewRange, cell.EntireRow) 
     MyCount = MyCount + 1 
    End If 
    Next cell 
    If ExistCount > 0 Then 
     NewRange.Copy Destination:=Worksheets("Alonso Approved List").Range("A3") 
    End If 
End Sub 

그래서 짧은 내가에서 행 번호 주어진 또 다른의 목록을 하나의 워크 시트에서 데이터를 받아 생성하기 위해 위의 코드를 수정할 " 셀 "범위와 특정 열을 나타냅니다.

카드 모기지 자동 소매 상업 투자 자문 컬렉션 운영 정보 기술 커뮤니티 담당 HR 마케팅 재산권 집행 금융 위험 신용 소싱 직원 관리 RCC

: 다음 항목 중 하나를 포함

열 G 드롭 다운 데이터 유효성 검사 목록

그럴 수 있습니까?

제목에 사용할 열을 결정하기 위해 match 함수와 같은 것을 사용할 수 있다면 정말 좋을 것입니다.

이 스프레드 시트는 여러 사용자가 정기적으로 업데이트하므로 정보가 정적이 아닙니다. 행은 자주 추가되고 변경되며 때때로 삭제됩니다. 따라서 원본 시트의 셀 값을 새 목록으로 복사 할 수는 없습니다.

질문 응답 :

1. 열 G 한 여러 항목을 포함하는 데이터 유효성 검사 드롭 다운 목록을. 전체 목록은 다른 워크 시트에 있습니다. 사용자는 각 광고 항목에 들어가 특정 카테고리를 선택합니다.
2. 기타 항목에는 광고 항목의 이름, 카테고리 (G 열과 동일), 금전적 가치 및 날짜가 포함됩니다.
3. 많은 정보가 회사 정보이기 때문에 업로드하는 것을 주저합니다. 내 목표는 매크로가 자동으로 동일한 행의 여러 셀을 다른 시트로 복사하도록하는 것입니다. 루핑과 올바른 행 감지가 이미 있습니다. 기본적으로 "cell.EntireRow"(전체 행 복사)를 셀의 일부 선택 행으로 대체하는 방법이 있습니까?

Answer 1

나는이 질문에 대한 대답으로 대답하고 싶었다. 약간 지연 되긴하지만 답변 된 질문은 영구적으로 열린 질문보다 낫습니다.

Sub ApprovedList() 

Dim cell As Range 
Dim rngDest As Range 
Dim i As Long 
Dim arrColsToCopy 

    arrColsToCopy = Array(1, 3, 4, 5) 
    '----For every cell in row G on the ESI Project Data sheet----' 
    Set rngDest = Worksheets("Alonso Approved List").Range("A3") 

    Application.ScreenUpdating = False 

    For Each cell In Worksheets("ESI Project Data").Range("G6:G5000").Cells 

     If cell.Value = "Card" Then 

      For i = LBound(arrColsToCopy) To UBound(arrColsToCopy) 
       With cell.EntireRow 
        .Cells(arrColsToCopy(i)).Copy rngDest.Offset(0, i) 
       End With 
      Next i 

      Set rngDest = rngDest.Offset(1, 0) 'next destination row 

     End If 

    Next cell 

    Application.ScreenUpdating = True 

End Sub