워크 시트의 열을 통해 루프, 새 통합 문서의 새 워크 시트에 데이터 복사 - 인스턴트 메신저

Question

모든 워크 시트가 동일한 열 머리글로 구성된 통합 문서가 있습니다. 각 워크 시트의 행은 직원 작업 및 기타 작업 정보를 식별합니다. AB-BE에서 시작하는 열은 종업원의 제목을 열 이름으로 포함하고 행의 전자 메일 주소가 해당 작업을 도운 경우 포함합니다. 해당 행이 해당 작업에 영향을주지 않으면 행의 일부가 특정 열에 있습니다.

다음 작업을 수행하려고합니다.

새 워크 시트 AB 통해 루프를 추가 할에 대한 새 통합 문서를 만듭니다 : BE와 워크 시트 이름 필터이 열 (예 : AB)와 같은 열 머리글 이름으로 새 통합 문서에 새 워크 시트를 만듭니다 만 포함 이 목록에있는 데이터이며 공백이 아님 이 열 데이터 (예 : AB)를이 새 워크 시트에 복사 원래 워크 시트의 행 B, F, H를이 새 워크 시트로 복사 기본 워크 시트의 필터 지우기

다음 열로 반복 (예제 AC), 통합 문서에 새 워크 시트를 만들 때 반복하십시오.

나는 과거에이 행을 잘 처리했습니다. 어떻게 작동해야하는지 개념적으로 생각하고 있습니다.

누구에게 사례가 있습니까? 나는 며칠 동안 Google을 검색했지만 일부 영역에서는 가까이 다가 갈 수는 있지만 데이터의 확장 성이 좋지는 않습니다.

Answer 1

참고 :이 작업은 고급 필터를 사용하여 수행 할 수도 있습니다. 이를 통해 필터링 된 범위를 새 시트에 복사 할 수 있습니다.

시트 레이아웃을 완전히 이해하고 있는지 확신 할 수 없지만 각 열 AB에 대해 새 시트를 만드는 데 필요한 기본 코드는 비어 있지 않은 열 AB의 각 행에 대해 해당 셀을 복사합니다 값을 B, F 및 H 열의 값과 함께 해당 새 워크 시트의 행에 추가합니다. 그런 다음 AC : BE 열을 반복하십시오.

Sub CopyRoles() 

Dim nSheet As Integer 
Dim nTasks As Integer 
Dim nSourceRow As Long 
Dim nDestRow As Long 
Dim wkb As Workbook 
Dim wksSource As Worksheet 
Dim wksDest As Worksheet 

Set wksSource = ActiveSheet 
Set wkb = Workbooks.Add 
For nTasks = wksSource.Range("AB1").Column To wksSource.Range("BE1").Column 
    nSheet = nTasks - wksSource.Range("AB1").Column + 1 
    With wkb.Sheets 
     If .Count < nSheet Then ' Checks if sheet count on wkb exceeded 
      Set wksDest = .Add(after:=.Item(.Count), Type:=xlWorksheet) 
     Else 
      Set wksDest = .Item(nSheet) ' Keeps from having empty sheets 
     End If 
     wksDest.Name = wksSource.Cells(1, nTasks) 
    End With 

    With wksSource 
     wksDest.Cells(1, 1) = "E-mail address" ' Add header row to sheet 
     wksDest.Cells(1, 2) = .Cells(.UsedRange.Row, 2) ' Col B 
     wksDest.Cells(1, 3) = .Cells(.UsedRange.Row, 6) ' Col F 
     wksDest.Cells(1, 4) = .Cells(.UsedRange.Row, 8) ' Col H 
     nDestRow = 2 
     For nSourceRow = .UsedRange.Row + 1 To .UsedRange.Rows.Count 
      If .Cells(nSourceRow, nTasks).Value <> "" Then 
       wksDest.Cells(nDestRow, 1).FormulaR1C1 = _ 
        .Cells(nSourceRow, nTasks).Value 
       wksDest.Cells(nDestRow, 2).FormulaR1C1 = _ 
        .Range("B" & nSourceRow).Value 
       wksDest.Cells(nDestRow, 3).FormulaR1C1 = _ 
        .Range("F" & nSourceRow).Value 
       wksDest.Cells(nDestRow, 4).FormulaR1C1 = _ 
        .Range("H" & nSourceRow).Value 
       nDestRow = nDestRow + 1 
      End If 
     Next nSourceRow 
    End With 
Next nTasks 

wkb.SaveAs 

End Sub