Copy row to another worksheet if value met

Robert Bradshaw

New Member
Joined
Aug 14, 2020
Messages
3
Office Version
  1. 2016
Platform
  1. Windows
Hello all this is my first post and also learning vba. I was hoping to get some help solving this issue. I am trying to copy and paste rows with a true value of "open" in column A to a specified worksheet("Open Disc") from all available worksheets. When pasting all true values, I would like for it to make a running list as it transitions through worksheets without large gaps of blank spacing. The current vba i have been working with is searching forbthe value of open but when found it pastes to the same row/col as its found in. When searching multiple worksheets it pastes over rows of matching row/col's. Is there a way to search all worksheets, copy true value row in col A and paste to specified worksheet one after another until all sheets are searched?
Code used:

Sub filter()
Dim cell as range
Dim xsheet as integer

For xsheet = 2 to sheets.count
With worksheets(xsheet)

For each cell.value = "open" then
Sheets("Open Disc").unprotected
.rows(cell.row).copy sheets("Open. Disc").rows(cell.row)
End if
Next cell
Sheets("Open Disc").protect
Range ("B1").select
End with
Next xsheet

End sub
 

Some videos you may like

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,689
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
Change references where required.
If the sheets have lots of data, it probably will be faster with AutoFilter.
Code:
Sub Maybe()
Dim sh2 As Worksheet, i As Long, j As Long
Application.ScreenUpdating = False
Set sh2 = ThisWorkbook.Sheets("Open Disc")
For i = 2 To ThisWorkbook.Sheets.Count
    With Sheets(i)
        For j = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
            If .Cells(j, 1).Value = "open" Then .Cells(j, 1).EntireRow.Copy sh2.Cells(Rows.Count, 1).End(xlUp).Offset(1)
        Next j
    End With
Next i
Application.ScreenUpdating = True
End Sub
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
Maybe this
VBA Code:
Sub t()
Dim sh As Worksheet
Sheets("Open Disc").Unprotect
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "Open Disc" Then
            sh.UsedRange.AutoFilter 1, "open"
            sh.UsedRange.Offset(1).SpecialCells(xlCellTypeVisible).Copy _
            Sheets("Open Disc").Cells(Rows.Count, 1).End(xlUp)(2)
            sh.AutoFilterMode = False
        End If
    Next
Sheets("Open Disc").Protect
End Sub
 

Robert Bradshaw

New Member
Joined
Aug 14, 2020
Messages
3
Office Version
  1. 2016
Platform
  1. Windows
Thank you you both for your help but unfortunately that did not resolve the issue. The original post was done via mobile, i will try and clarify more. The Macro will be ran from the "Open Disc" sheet. Attached is an image of the sheet for column referencing. Search criteria would be conducted on all sheets in column A except "Open Disc" sheet. "Open Disc" sheet is where the results from all rows with "open" value in col A would be placed from all sheets. I hope this helps clarify more. Current result I was getting using your coding was that each run of the code returned a blank screen. If i need to clarify more, please let me know and thank you again for your assistance.

Capture1.PNG
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

see if this works better. The code should be run from a public code module, not a sheet or workbook module. Any numbered module is a public module.

VBA Code:
Sub t2()
Dim sh As Worksheet, rng As Range, hdr As Boolean
Sheets("Open Disc").Unprotect
    For Each sh In ThisWorkbook.Sheets
        hdr = True
        If sh.Name <> "Open Disc" Then
            Set rng = sh.Range("A11", sh.Cells(Rows.Count, 1).End(xlUp))
            If sh.Range("A11") = "" Then
                hdr = False
                sh.Range("A11") = "x"
            End If
            rng.AutoFilter 1, "open"
            rng.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Copy _
            Sheets("Open Disc").Cells(Rows.Count, 1).End(xlUp)(2)
            sh.AutoFilterMode = False
            If hdr = False Then
                sh.Range("A11").ClearContents
            End If
        End If
    Next
Sheets("Open Disc").Protect
End Sub
 
Last edited:

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,689
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
Have a look at your posts again.
In the post you mention "open" (all small letters) and it the example it is "Open" (with a capital O)
Change that in the suggestions and let us know the outcome.
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

Have a look at your posts again.
In the post you mention "open" (all small letters) and it the example it is "Open" (with a capital O)
Change that in the suggestions and let us know the outcome.
Will make no difference in my code, the autofilter is case insensitive. I do notice that one of the sheets named "Do Not Touch" and was wondering if it should be excluded from those that have data copied from them.
 
Last edited:

Robert Bradshaw

New Member
Joined
Aug 14, 2020
Messages
3
Office Version
  1. 2016
Platform
  1. Windows
All,

JLGWhiz code for the t() worked out after all. the issue i was having was the worksheets were still protected and would not perform the search until unlocked. Thank you both very much for helping with this project. I cant say enough how happy I am to finally have this working. Thanks!!!
 

jolivanes

Well-known Member
Joined
Sep 5, 2004
Messages
1,689
Office Version
  1. 2013
  2. 2007
Platform
  1. Windows
Glad you have it sorted.
Good Luck
 

JLGWhiz

Well-known Member
Joined
Feb 7, 2012
Messages
12,979
Office Version
  1. 2013
Platform
  1. Windows
All,

JLGWhiz code for the t() worked out after all. the issue i was having was the worksheets were still protected and would not perform the search until unlocked. Thank you both very much for helping with this project. I cant say enough how happy I am to finally have this working. Thanks!!!
Helps to mention those things in the OP. Thanks for the feedback.
Regards, JLG
 

Watch MrExcel Video

Forum statistics

Threads
1,122,371
Messages
5,595,784
Members
414,020
Latest member
Meghdad

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top