JannetteChristie
Board Regular
- Joined
- Dec 14, 2015
- Messages
- 137
- Office Version
- 365
Hi,
Hoping someone can help me out here.
I am trying to loop through the worksheets called PP-RF*, read the contents in Column A and then copy the record to a named sheet.
This code loops through the worksheet names:
I am having trouble with the copying of the record to the named sheet
Hoping someone can help me out here.
I am trying to loop through the worksheets called PP-RF*, read the contents in Column A and then copy the record to a named sheet.
This code loops through the worksheet names:
Sub ForEachWs()
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
If ws.Name Like "*" & "RF" & "*" Then
MoveRecsToSheet ws
End If
Next ws
End Sub
I am having trouble with the copying of the record to the named sheet
Select method of worksheet class failedSub MoveRecsToSheet(ws As Worksheet)
Dim c As Integer
Dim x As Integer
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim Sheetname As String
Dim lCopyLastRow As Long
Dim lDestLastRow As Long
Application.ScreenUpdating = False
Set wsCopy = Worksheets(ws.Name)
Set wsDest = Worksheets("Pipe")
Sheetname = ws.Name
Sheets(Sheetname).Select
lCopyLastRow = wsCopy.Cells(wsCopy.Rows.Count, "A").End(xlUp).Row
c = 2
For x = 1 To lCopyLastRow
If InStr(1, Range("B" & c).Value, "31-") > 0 Then
Sheets(ws.Name).Cells(x, 1).EntireRow.Copy
lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "A").End(x1Up).Offset(1).Row
Range("A" & lDestLastRow).Select
Selection.PasteSpecial
Sheets(Sheetname).Select
End If
c = c + 1
ActiveCell.Offset(1, 0).Select
Next
Application.ScreenUpdating = True
End Sub