根据单元格内容将数据的一部分行从一个工作表复制到同一工作簿中的新工作表 [英] Copy a partial row of data from one sheet to a new sheet within the same workbook based on cell content

问题描述

我已经在网上搜寻了可以解决此挑战的解决方案，但没有找到合适的解决方案.我对公式很了解，但是没有在VBA或Excel中进行其他编程的经验.我希望众多Excel专家中的一位能够帮助我解决这一挑战.

I have scoured the web for a solution to this challenge that I am having, but have not found a suitable solution. I have decent with formulas, but have no experience in VBA or other programming within Excel. I am hoping that one of the many Excel gurus can help me solve this challenge.

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

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

The rows of data always begin in row 4 and can extend down to row 1000.

我有一张由基础公式产生的数据表(链接上方).我的目标是根据同一行F列的内容复制部分数据行，同时保留公式和原始数据不变.高于4的行和O列需要保留在原始工作表上.

I have a sheet of data (Linked Above) that was produced by underlying formulas. My goal is to copy partial rows of data based on the content of column F of the same row, while leaving both the formula and original data intact. Rows above 4 and column O need to remain on the original sheet.

例如...

行4在F列中为ab1.需要将以下单元格A4到N4复制到标有客户端1的工作表上.

Row 4 has in column F, ab1. The following cells A4 through N4 need to be copied to sheet labeled Client 1.

第5行在F列中为ab1.以下单元格A5至N5需要复制到标有客户端1的工作表上.

Row 5 has in column F, ab1. The following cells A5 through N5 need to be copied to sheet labeled Client 1.

行5在F列中为ab2.需要将以下单元格A6到N6复制到标有客户端2的工作表上.

Row 5 has in column F, ab2. The following cells A6 through N6 need to be copied to sheet labeled Client 2.

此过程一直持续到数据结束.

This process continues through to the end of the data.

非常感谢您可以提供的任何帮助.

Thanks so much in advance for any assistance that can be provided.

欢呼 斯科特

推荐答案

类似的东西应该可以帮助您入门.我试图对它进行彻底的评论，以解释宏中正在发生的事情:

Something like this should get you started. I have tried to comment it pretty thoroughly so as to explain what is happening in the macro:

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

这篇关于根据单元格内容将数据的一部分行从一个工作表复制到同一工作簿中的新工作表的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！