Copy row to sheets if cell in col A=sheetname

[Mike Moran]

Hi-

Been all over the web today and in this forum, and so close, but no cigar.

I need to copy a row from "Master" sheet to other named sheets in one workbook, based upon CellValue Col A = sheet name. Continue down col A, copying the row to the appropriate sheet (jumping to End.xlUp.offset1 of course).

Here's one I tried (edited and edited to try and match what I'm attempting - this is the original I found):

Sub CopyYes()  'Static Sheets and rows ONLY
    Dim c As Range
    Dim j As Integer
    Dim Source As Worksheet
    Dim Target As Worksheet


    ' Change worksheet designations as needed
    Set Source = ActiveWorkbook.Worksheets("Sheet1")
    Set Target = ActiveWorkbook.Worksheets("Sheet2")


    j = 1     ' Start copying to row 1 in target sheet
    For Each c In Source.Range("A1:A1000")   ' Do 1000 rows
        If c = "yes" Then
           Source.Rows(c.Row).Copy Target.Rows(j)
           j = j + 1
        End If
    Next c

Ideally, this will be a workbook that's updated constantly, so I don't keep adding the same data from Master to the bottom of the sheets every time I run the macro. That's probably a follow-up research issue.

 

[Mike Moran]

Hey guys,

Been teaching myself a lot. Here's something I came up with that will refresh the data from row 2 on when we run it, since there are changes as time passes.

Getting "Run-time error 13" on this, but don't see where I screwed up. Other than that I think this is going to work (fingers crossed).

Sub fill3()
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Dim Master As Worksheet
    Dim Caps As Worksheet
    Dim Resistors As Worksheet
    Dim Relays As Worksheet
    Dim Semis As Worksheet
    Dim Misc As Worksheet
    Dim MyCat As Range
    Dim MyRow As Range
    Dim LastRow  As Long
    Dim RowNum As Integer
    'Dim Response As Integer
    Dim erow As Integer   'erow=EmptyRow
    Set Master = Sheets("Master")
    Set Caps = Sheets("Caps")
    Set Resistors = Sheets("Resistors")
    Set Semis = Sheets("Semis")
    Set Misc = Sheets("Misc")
    Set MyCat = Range("A:A") 'RowNum could be user input
    Dim i As Integer
    
    LastRow = Master.Cells(Rows.Count, "A").End(xlUp).row
    
'Use case to copy to correct sheet
    For i = 2 To LastRow
        Set MyRow = Range(Cells(i, 1), Cells(i, 9))
        
        Select Case MyCat


            Case "Caps"
                'Paste something
                erow = Worksheets("Caps").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).row
                Worksheets("Master").Range("MyRow").Value = Worksheets("Caps").Range(erow, 1).Value
            Case "Resistors"
                erow = Worksheets("Resistors").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).row
                Worksheets("Master").Range("MyRow").Value = Worksheets("Caps").Range(erow, 1).Value
            Case "Relays"
                erow = Worksheets("Resistors").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).row
                Worksheets("Master").Range("MyRow").Value = Worksheets("Resistors").Range(erow, 1).Value
            Case "Semis"
                erow = Worksheets("Semis").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).row
                Worksheets("Master").Range("MyRow").Value = Worksheets("Semis").Range(erow, 1).Value
            Case "Misc"
                erow = Worksheets("Misc").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).row
                Worksheets("Master").Range("MyRow").Value = Worksheets("Misc").Range(erow, 1).Value
            Case Else
                Worksheets("Master").Range("MyRow").Interior.Color = RGB(255, 0, 0) 'MAKE ROW RED
          End Select
    Next i
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True


End Sub