aselder
New Member
- Joined
- Nov 15, 2021
- Messages
- 2
- Office Version
- 2016
- Platform
- Windows
Ok - so I've figured out a few more things that help me, and I got the code to run on all 50 worksheets, but now I'm finding that it is not copying the last row in the range. *OR* it's somehow writing over the previous worksheet's entry onto the "BigSpreadsheet" tab. Either way, I'm missing the last entry from each worksheet when compiling into the master spreadsheet. My code has evolved to:
I think it has to do with the line:
But I can't seem to figure it out. Can you guys help?
VBA Code:
Sub CopyRows()
'
' Copy all rows that start with User inputted information and paste them into a new spreadsheet
'
Dim wsNew As String, xSht As Object, qtr As String
Dim Exists As Boolean, Cell As Range, ws As Worksheet, sh As Worksheet
Dim SourceRange As Range, EntireColumn As Range, EntireRow As Range
' Don't update the screen until the program is finished running (makes the program run faster).
Application.ScreenUpdating = False
' Create new worksheet and check to make sure it's not already created.
On Error Resume Next
wsNew = InputBox("Please enter a name for the new combined worksheet:", "BigSpreadsheet Input")
Set xSht = Sheets(wsNew)
If Not xSht Is Nothing Then
MsgBox "Worksheet cannot be created as there is already a worksheet with the same name in this workbook.", , "You tryin' to start something?"
Exit Sub
End If
Sheets.Add.Name = wsNew
Set sh = Sheets(wsNew)
' Obtain User input for which quarter they want the program to run for
qtr = InputBox("Please enter the quarter (1st, 2nd, 3rd, or 4th):", "Enter Quarter")
'sh.UsedRange.Offset(1).Clear ' If required, this line will clear the BigSpreadsheet with each transfer of data.
For Each ws In Worksheets
If ws.Name <> wsNew Then
With ws.[A1].CurrentRegion
.AutoFilter 1, Criteria1:="*" & qtr & "*"
.Offset(1).EntireRow.Copy sh.Range("A" & Rows.Count).End(xlUp)
.AutoFilter
End With
End If
Next ws
Application.ScreenUpdating = True
End Sub
I think it has to do with the line:
VBA Code:
.Offset(1).EntireRow.Copy sh.Range("A" & Rows.Count).End(xlUp)
But I can't seem to figure it out. Can you guys help?
Last edited by a moderator: