根据单元格内容，将数据的部分行从一个工作表复制到同一工作簿中的新工作表

Question

我已经在网上搜索了这个挑战的解决方案，但还没有找到合适的解决方案。我有体面的公式，但没有在Excel中的VBA或其他编程经验。我希望有一位Excel高手能帮我解决这个难题。

纸样https://dl.dropboxusercontent.com/u/95272767/Sample%20Sheet.xlsx

数据行总是从第4行开始，可以向下扩展到第1000行。

我有一张由底层公式生成的数据表(链接在上面)。我的目标是根据同一行F列的内容复制数据的部分行，同时保留公式和原始数据的完整性。第4行以上和第0列需要保留在原始工作表上。

例如…

第4行在F列中有ab1。下面的单元格A4到N4需要复制到标签为Client 1的工作表中。

第5行在F列中有ab1。下面的单元格A5到N5需要复制到标签为Client 1的工作表中。

第5行在F列中有ab2。以下单元格A6至N6需要复制到标签为Client 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