셀 내용을 기반으로 한 통합 문서 내에서 한 시트의 일부 데이터 행을 동일한 시트에 복사합니다.

Question

나는이 도전에 대한 해결책을 웹에서 찾았지만 적절한 해결책을 찾지 못했습니다. 수식에는 괜찮 았지만 VBA 또는 Excel 내 다른 프로그래밍에 대한 경험이 없습니다. 많은 Excel 전문가 중 한 명이이 문제를 해결하는 데 도움이되기를 바랍니다.

시트 샘플 데이터 행이 항상 4 행에서 시작하여 1000

I는 기본 식에 의해 생성 된 데이터 (상기 연계)의 시트를 행 아래로 확장 할 수 https://dl.dropboxusercontent.com/u/95272767/Sample%20Sheet.xlsx

. 내 목표는 동일한 행의 열 F의 내용을 기반으로 부분 행의 데이터를 복사하는 동시에 수식과 원본 데이터는 그대로 유지하는 것입니다. 행 4와 열 0은 원본 시트에 남아 있어야합니다.

예를 들면 ...

행 4는 열 F, ab1에 있습니다. 다음 셀 A4에서 N4는 클라이언트 1로 레이블 된 시트에 복사해야합니다.

행 5는 열 F, ab1에 있습니다. 다음 셀 A5에서 N5는 클라이언트 1로 레이블 된 시트에 복사해야합니다.

행 5는 열 F, ab2에 있습니다. 다음 셀 A6에서 N6을 클라이언트 2라고 표시된 시트에 복사해야합니다.

이 프로세스는 데이터의 끝까지 계속됩니다.

도움을 주셔서 대단히 감사드립니다. 이 같은

건배 스콧

Answer 1

뭔가 당신이 시작할 수 있어야합니다. 매크로에서 무슨 일이 일어나는지 설명하기 위해 꽤 철저히 설명하려고 시도했습니다.

Sub CopySomeCells() 
Dim targetSheet As Worksheet 'destination for the copied cells' 
Dim sourceSheet As Worksheet 'source of data worksheet' 
Dim rng As Range 'range variable for all data' 
Dim rngToCopy As Range 'range to copy' 
Dim r As Long 'row counter' 
Dim x As Long 'row finder' 
Dim clientCode As String 
Dim clientSheet As String 

Set sourceSheet = Worksheets("Sheet1") '## The source data worksheet, modify as needed ## 
    With sourceSheet 
     '## the sheet may have data between rows 4 and 1000, modify as needed ##' 
     Set rng = .Range("A4", Range("A1000").End(xlUp)) 

     '## iterate over the rows in the range we defined above ##' 
     For r = 1 To rng.Rows.Count 


      '## Set the range to copy ##' 
      Set rngToCopy = Range(rng.Cells(r, 1), rng.Cells(r, 12)) 

      '## ignore rows that don't have a value in column F ## 
      If Not rng.Cells(r, 6).Value = vbNullString Then 

       '## Set the targetSheet dynamically, based on the code in column F ##' 
       ' e.g., "ab1" --> Client 1, "ab2" --> Client 2, etc. ' 
       '## Set the client code ##" 
       clientCode = rng.Cells(r, 6).Value 

       '## determine what sheet to use ##' 
       ' I do this by finding the client code in the lookup table, which 
       ' is in range "O24:O37", using the MATCH function. 
       ' Then, offset it -1 rows (the row above) which will tell us "Client Code 1", etc. 

       clientSheet = .Range("O23").Offset(_ 
        Application.Match(clientCode, .Range("O24:O37"), False), 0).Offset(-1, 0).Value 
       ' take that value "Client Code 1" and replace "Code " with nothing, so that 
       ' will then give us the sheet name, e.g., "Client Code 1" --> "Client 1", etc. ##' 
       clientSheet = Replace(clientSheet, "Code ", vbNullString) 

       Set targetSheet = Worksheets(clientSheet) 

       '## Find the next empty row in this worksheet ##' 
       x = Application.WorksheetFunction.CountA(targetSheet.Range("A:A")) + 1 

       '## Copy the selected sub-range, ##' 

       rngToCopy.Copy 

       '## Paste values only to the target sheet ##' 
       targetSheet.Cells(x, 1).PasteSpecial Paste:=xlPasteValues, _ 
        Operation:=xlNone, SkipBlanks:=False, Transpose:=False 

      End If 

     Next '## proceed to process the next row in this range ##' 

    End With 

End Sub