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

我已经在网上搜寻了一个解决我面临的这个挑战的方法，但是还没有找到一个合适的方法。我精通公式，但没有VBA或Excel中其他编程的经验。我希望众多Excel大师中的一位能够帮助我解决这一挑战

样本表

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

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

例如

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

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

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

这个过程一直持续到数据的末尾

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

干杯

---

斯科特

像这样的事情应该会让你开始。为了解释宏观经济中正在发生的事情，我试图对其进行彻底的评论：

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

---

非常感谢您的快速回答和详细的评论。有一件事我没有澄清。客户机代码基于变量，如人名首字母，如果有多个具有相同首字母，则可以有一个数字<代码>代码“##根据F列中的数字动态设置目标工作表，例如“ab1”-->Client 1，“ab2”-->Client 2等。”设置目标工作表=工作表（“客户端”和#替换（rng.Cells（r，6）.Value，“ab”，vbNullString））

code

看来我把以前的回复搞砸了。。。对不起。：）为了继续我的想法，我计划将五张客户表预构建为客户1、客户2等。引用动态创建的工作表的脚本行需要更改什么？工作表右侧的客户机代码是用户输入的客户机代码，将在创建我附加的样本工作表时搜索这些客户机代码。感谢ScottI通过测试还发现，数据是从每个客户工作表的第一行开始写入的。是否有一种方法可以从每个客户端页面的第4行开始写入行？这样，我可以添加相同的标题以及与第1页不同的内容。再次感谢你的帮助。最初给出的代码与我先前在原始问题中描述的完全一样。Scottchange >代码> x=应用程序.WorkSueToal.CurnTa（目标表.范围（a：a））+>代码> x= Apple .WorkSeTeal.CuffTa（目标表.范围（A:A））+4 ，这应该从每个客户端工作表中的第4行开始.此外，如果这有助于解决您的问题，请考虑将答案标记为“接受”.干杯