Copy rows from multiple Sheets into one, then order by column - excel

Question

I am trying to create a single VBA that searches seven different sheets for a particular entry in Column E and then copy the entire row into a 8th Sheet and placing them in order by column A.
I got the point for it to search for one spreadsheet and copying the items over to the other in the exact same row they are located on the spreadsheet
Sub Test()
Dim rw As Long, Cell As Range
For Each Cell In Tues.Range("E:E")
rw = Cell.Row
If Cell.Value = "No" Then
Cell.EntireRow.Copy
Sheets("Completed").Range("A" & rw).PasteSpecial
End If
Next
End Sub
The Spreadsheets I want to search for are:
Mon
Tues
Wed
Thurs
Fri
Sat
Sun
The sheet I want to move it to is called Completed, then I want it to sort by Column A.
Any Ideas?

Answer 1

How about this:
Sub loop_through_WS()
Dim rw As Long, i As Long, lastRow As Long, compLastRow&
Dim cel As Range
Dim mainWS As Worksheet, ws As Worksheet
Dim sheetArray() As Variant
sheetArray() = Array("Mon", "Tues", "Weds", "Thurs", "Fri", "Sat", "Sun")
Set mainWS = Sheets("Completed")
compLastRow = mainWS.Cells(mainWS.Rows.Count, 1).End(xlUp).row
For i = LBound(sheetArray) To UBound(sheetArray)
With Sheets(sheetArray(i))
lastRow = .Cells(.Rows.Count, 5).End(xlUp).row
For Each cel In .Range("E1:E" & lastRow)
rw = cel.row
If cel.Value = "No" Then
cel.EntireRow.copy
mainWS.Range("A" & compLastRow).pasteSpecial
compLastRow = mainWS.Cells(mainWS.Rows.Count, 1).End(xlUp).row + 1
End If
Next
End With
Next i
Application.CutCopyMode = False
End Sub
It basically uses the code you gave, but I added the worksheet loop (it'll loop through each of the day worksheets) and paste back onto the "Completed" WS.
See if you can work out how I looped through the worksheets - I use this type of thing often so it'd be good to learn if you are doing much of this. It also allows you to add another sheet (say "Weekend") to your workbook and all you have to do is add "Weekend" after "Sun" in the Array. That's the only place you'll need to add it.
One note is that I changed your for each Cell in Range(E:E) to be from E1 to the last Row in column E - which makes the macro run way faster.
Edit: As mentioned in my comment above, it's generally not recommended to use Cell as a variable name. (Same goes for Column, Row, Range, etc.) because these all mean something specifically to VBA (i.e. Cell([row],[column]). Instead, as you see, I like to use cel or rng or iCell,etc.

Answer 2

Something like this should work for you based on what you've described. It uses a For Each loop to iterate through the sheets and uses the AutoFilter method to find what it's looking for from column E. The code assumes headers are in row 1 on each sheet. I attempted to comment it for clarity.
Sub tgr()
Dim wb As Workbook
Dim ws As Worksheet
Dim wsCompleted As Worksheet
Dim bHeaders As Boolean
Set wb = ActiveWorkbook
Set wsCompleted = wb.Sheets("Completed")
bHeaders = False
'Comment out or delete the following line if you do not want to clear current contents of the Completed sheet
wsCompleted.Range("A2", wsCompleted.Cells(Rows.Count, Columns.Count)).Clear
'Begin loop through your sheets
For Each ws In wb.Sheets
'Only perform operation if sheet is a day of the week
If InStr(1, " Mon Tue Wed Thu Fri Sat Sun ", " " & Left(ws.Name, 3) & " ", vbTextCompare) > 0 Then
'If headers haven't been brought in to wsCompleted yet, copy over headers
If bHeaders = False Then
ws.Rows(1).EntireRow.Copy wsCompleted.Range("A1")
bHeaders = True
End If
'Filter on column E for the word "No" and copy over all rows
With ws.Range("E1", ws.Cells(ws.Rows.Count, "E").End(xlUp))
.AutoFilter 1, "no"
.Offset(1).Resize(.Rows.Count - 1).EntireRow.Copy wsCompleted.Cells(wsCompleted.Rows.Count, "A").End(xlUp).Offset(1)
.AutoFilter
End With
End If
Next ws
'Sort wsCompleted by column A
wsCompleted.Range("A1").CurrentRegion.Sort wsCompleted.Range("A1"), xlAscending, Header:=xlGuess
End Sub
EDIT: Here is the sample workbook that contains the code. When I run the code, it works as intended. Is your workbook data setup drastically different?
https://drive.google.com/file/d/0Bz-nM5djZBWYaFV3WnprRC1GMnM/view?usp=sharing

Answer 3

The answers posted earlier have some great stuff in them, but I think this will get you exactly what you after with no issues and also with great speed. I made some assumptions on how your data is laid out, but commented them. Let me know how it goes.
Sub PasteNos()
Dim wsComp As Worksheet
Dim vSheets() As Variant
Application.ScreenUpdating = False
vSheets() = Array("Mon", "Tues", "Weds", "Thurs", "Fri", "Sat", "Sun")
Set wsComp = Sheets("Completed")
For i = LBound(vSheets) To UBound(vSheets)
With Sheets(vSheets(i))
.AutoFilterMode = False
.Range(.Range("E1"), .Cells(.Rows.Count, 5).End(xlUp)).AutoFiler 1, "No"
'assumes row 1 has headers
.Range(.Range("E2"), .Cells(.Rows.Count, 5).End(xlUp)).SpecialCells(xlCellTypeVisible).EntireRow.Copy
'pastes into next available row
With wsComp
.Range("A" & .Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValues 'assumes copy values over
End With
End With
Next i
'assumes ascending order, headers in row 1, and that data is row-by-row with no blank rows
wsComp.UsedRange.Sort 1, xlAscending, Header:=xlYes
Application.ScreenUpdating = True
End Sub