-2

我已经在网上搜索了解决我遇到的这个挑战的方法，但还没有找到合适的解决方案。我对公式有很好的了解，但没有 VBA 或 Excel 中的其他编程经验。我希望众多 Excel 大师中的一位可以帮助我解决这一挑战。

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

数据行总是从第 4 行开始，并且可以向下延伸到第 1000 行。

我有一张由基础公式生成的数据表（以上链接）。我的目标是根据同一行的 F 列的内容复制部分数据行，同时保持公式和原始数据不变。第 4 行以上和 O 列需要保留在原始工作表上。

例如...

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

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

第 5 行在 F 列中有 ab2。需要将以下单元格 A6 到 N6 复制到标有 Client 2 的工作表中。

这个过程一直持续到数据结束。

非常感谢您提供的任何帮助。

干杯斯科特

4

1 回答 1

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
于 2013-05-09T03:11:43.757 回答