If Cell.Value is specific size, Copy 3 cells in th

Question

I have an excel document that I fill out with tshirt sizes, names, and numbers. The goal here is... once the form is filled out, I can hit a button that will copy all the smalls and put them onto a new sheet, all the mediums, onto another, and so on. I CAN select the whole row, but I ONLY WANT to copy a few cells. I am also pasting them at this point into the same row on the new sheet as they were in the old sheet. I just want them to show up on the next available line. Here are some examples...

IN EXCEL SHEET(1) "MAIN"

B                  C               D
-----------------------------------------
**Name**         | Size          | #    |
-----------------------------------------
Joe                Small           1              There are other
Sarah              X-Small         3              instructions over
Peter              Large           6              here on this side
Sam                Medium          12             of the document
Ben                Small           14             that are important
Rick               Large           26

IN EXCEL SHEET(2) "SMALL" AS IT SHOULD BE

B                  C               D
-----------------------------------------
**Name**         | Size          | #    |
-----------------------------------------
Joe                Small           1
Ben                Small           14

IN EXCEL SHEET(2) "SMALL" WHAT IS HAPPENING

B                  C               D
-----------------------------------------
**Name**         | Size          | #    |
-----------------------------------------
Joe                Small           1              There are other



Ben                Small           14             that are important

HERE IS MY VBA CODE SO FAR

Private Sub CommandButton1_Click()
For Each Cell In Sheets(1).Range("B:B")
    If Cell.Value = "Small" Then
        matchRow = Cell.Row
        Rows(matchRow & ":" & matchRow).Select
        Selection.Copy

        Sheets("Small").Select
        ActiveSheet.Rows(matchRow).Select
        ActiveSheet.Paste
        Sheets("Main").Select
    End If
Next

ON TO THE NEXT SIZE...

In the first part, I am selecting the entire row because that is the row that contains the variable that I want in Column B, but I don't need the entire row, I only need to select Column B though D in that row.

Now I understand "matchRow" is also why the data is pasting on the same row as it was copied from, but I'm not sure how to make it go to next available line either.

Answer 1

Alternate method with lots of bells and whistles. Scott Craner's answer is likely far more practical considering your current experience level, but for anybody looking for a more advanced approach:

EDIT In comments, OP provided sample data:

_____B_____  __C__  _D_
Name         Size     #
Joe 1-Youth  Small    2
Ben 1-Youth  Small    7
Bob 1-Youth  Small   10
Joe 1-Youth  Small   13
Joe 1-Youth  Small   22
Joe 1-Youth  Small   32
Joe 1-Youth  Small   99
Joe 1-Youth  Small    1
Joe 1-Youth  Small    3
Joe 3-Youth  Large    6
Joe 3-Youth  Large   11
Joe 3-Youth  Large   21

Updated code and verified it works with the provided sample data and the original data:

Sub tgr()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim wsMain As Worksheet
    Dim rCopy As Range
    Dim rUnqSizes As Range
    Dim SizeCell As Range
    Dim sName As String
    Dim lAnswer As Long
    Dim i As Long

    Set wb = ActiveWorkbook
    Set wsMain = wb.Sheets("Main")

    lAnswer = MsgBox(Title:="Run Preference", _
                     Prompt:="Click YES to override existing data." & _
                     Chr(10) & "Click NO to append data to bottom of sheets." & _
                     Chr(10) & "Click CANCEL to quit macro and do nothing.", _
                     Buttons:=vbYesNoCancel)

    If lAnswer = vbCancel Then Exit Sub

    With wsMain.Range("C1", wsMain.Cells(Rows.Count, "C").End(xlUp))
        If .Parent.FilterMode Then .Parent.ShowAllData
        On Error Resume Next
        .AdvancedFilter xlFilterInPlace, , , True
        Set rUnqSizes = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If rUnqSizes Is Nothing Then
            MsgBox "No Data found in column C", , "No Data"
            Exit Sub
        End If
        If .Parent.FilterMode Then .Parent.ShowAllData

        For Each SizeCell In rUnqSizes
            sName = SizeCell.Value
            For i = 1 To 7
                sName = Replace(sName, ":\/?*[]", " ")
            Next i
            sName = WorksheetFunction.Trim(Left(sName, 31))
            If Not Evaluate("ISREF('" & sName & "'!A1)") Then
                wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count)).Name = sName
                Set ws = wb.Sheets(sName)
                wsMain.Range("B1:D1").Copy
                ws.Range("B1").PasteSpecial xlPasteAll
                ws.Range("B1").PasteSpecial xlPasteColumnWidths
                Application.CutCopyMode = False
            Else
                Set ws = wb.Sheets(sName)
            End If
            .AutoFilter 1, SizeCell.Value
            Set rCopy = Intersect(wsMain.Range("B:D"), .Offset(1).Resize(.Rows.Count - 1).EntireRow)
            If lAnswer = vbNo Then
                rCopy.Copy ws.Cells(Rows.Count, "B").End(xlUp).Offset(1)
            Else
                ws.Range("B2:D" & Rows.Count).Clear
                rCopy.Copy ws.Range("B2")
            End If
        Next SizeCell
        If .Parent.FilterMode Then .Parent.ShowAllData
    End With

End Sub

Answer 2

Name the sheets the size and use this:

Private Sub CommandButton1_Click()
with sheets("Main")
    For Each Cell In .Range("C2",.range("C" & .rows.count).end(xlup))
        .range(.cells(cell.row,2),.cells(cell.row,4)).copy sheets(cell.value).range("B" & sheets(cell.value).rows.count).end(xlup).offset(1)               
    next cell
End with
End sub

Since the sheet is named as the size, the one line is sufficient. It copies only B to D on the row found and puts it in the next available row on the sheet named as the size.

Note: This will not work if the sheets are not named the same as the size in column C on the main sheet.

One should also avoid using the .select whenever possible, as it will slow down the code.

EDIT: with this layout:

I change the code to:

Private Sub CommandButton1_Click()
Dim mws As Worksheet
Dim tws As Worksheet

Set mws = Sheets("Main")

With mws
    For Each cell In .Range("B3", .Range("B" & .Rows.Count).End(xlUp))
        If Not SheetExists(cell.Value) Then
            Set tws = ActiveWorkbook.Sheets.Add
            tws.Name = cell.Value
            .Range("A2:D2").Copy tws.Range("A1")

        Else
            Set tws = Sheets(cell.Value)
        End If
        .Range(.Cells(cell.Row, 1), .Cells(cell.Row, 4)).Copy tws.Range("A" & tws.Rows.Count).End(xlUp).Offset(1)
        tws.Columns("A:D").AutoFit
    Next cell
End With
End Sub
Function SheetExists(SName As String, _
                     Optional ByVal WB As Workbook) As Boolean

    On Error Resume Next
    If WB Is Nothing Then Set WB = ActiveWorkbook
    SheetExists = CBool(Len(WB.Sheets(SName).Name))
End Function