[Solved] Copy a partial row of data from one sheet to a new sheet within the same workbook based on cell content

by


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

33

solved Copy a partial row of data from one sheet to a new sheet within the same workbook based on cell content