If Column U=Yes, copy entire row onto first blank row of new sheet

**soldevi53** · 02-09-2012, 11:22 AM

Hi all,

I'm trying to create a macro so that when you push the button on sheet "Meter List" it will copy any row from sheet "Index" that has Yes selected in the dropdown in Column U, and put that information starting in the first blank row which is Row A14 on the same sheet as the button

I have an example workbook with two dropdowns in a row. The code I tried so far is

Sub Copyrows()
 Dim Rws As Long, Rng As Range, Frng As Range, ShtRws As Long, ws As Worksheet, Crng As Range

    Rws = Cells(Rows.Count, "A").End(xlUp).Row
    Set ws = Worksheets("Meter List")
    Set Rng = Range(Cells(2, 1), Cells(Rws, 8))
    Set Frng = Range(Cells(3, 1), Cells(Rws, 8))
    ShtRws = ws.Cells(Rows.Count, "A").End(xlUp).Row + 1
    Set Crng = ws.Cells(ShtRws, 1)
    Application.ScreenUpdating = False
    
    With Rng
        .AutoFilter Field:=22, Criteria1:="yes"
       
    End With
    
    Range("F:F,D:D,B:B").EntireColumn.Hidden = True
    Frng.SpecialCells(xlCellTypeVisible).Copy Crng
    Range("F:F,D:D,B:B").EntireColumn.Hidden = False
    Rng.AutoFilter


End Sub

**soldevi53** · 02-09-2012, 11:55 AM

First code wasn't even close, trying this now, the code executes but nothing is copied, seems im missing the part to focus on sheet "Index"

Sub Copyrows()
  Dim LSearchRow As Integer
    Dim LCopyToRow As Integer

    On Error GoTo Err_Execute

    'Start search in row 13    LSearchRow = 13

    'Start copying data to row 2 in Sheet2 (row counter variable)
    LCopyToRow = 14

    While Len(Range("A" & CStr(LSearchRow)).Value) > 0

        'If value in column U = "Yes", copy entire row to Sheet2
        If Range("U" & CStr(LSearchRow)).Value = "Yes" Then

            'Select row in Sheet1 to copy
            Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select
            Selection.Copy

            'Paste row into Sheet2 in next row
            Sheets("Meter List").Select
            Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select
            ActiveSheet.Paste

            'Move counter to next row
            LCopyToRow = LCopyToRow + 1

            'Go back to Sheet1 to continue searching
            Sheets("Sheet1").Select

        End If

        LSearchRow = LSearchRow + 1

    Wend

    'Position on cell A3
    Application.CutCopyMode = False
    Range("A3").Select

    MsgBox "All matching data has been copied."

    Exit Sub

Err_Execute:
    MsgBox "An error occurred."

End Sub

Thread: If Column U=Yes, copy entire row onto first blank row of new sheet

Thread Tools

Display

If Column U=Yes, copy entire row onto first blank row of new sheet

Re: If Column U=Yes, copy entire row onto first blank row of new sheet

Thread Information

Users Browsing this Thread

Bookmarks

Bookmarks

Posting Permissions