Reputation: 85
All I want to do, within the same workbook, is to copy the value from cell B2 in several SELECTED worksheets and paste into column D in another worksheet called "Summary". In addition, I would like to also copy and paste the corresponding worksheet name in Column C. These are the two codes I have so far, both failed, not sure how to fix them, not sure if there is a better way to do it. I am new in VBA. I am sure you will find silly mistakes, please forgive me. Both codes fail under "Run-time error '5' : Invalid procedure call or argument". Any help is highly appreciated.
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim wb As Workbook
Dim DestSh As Worksheet
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ThisWorkbook
Set DestSh = wb.Sheets("Summary")
' Loop through worksheets that start with the name "20"
' This section I tested and it works
For Each sh In ActiveWorkbook.Worksheets
If LCase(Left(sh.Name, 2)) = "20" Then
' Specify the range to copy the data
' This portion has also been tested and it works
sh.Range("B2").Copy
' Paste copied range into "Summary" worksheet in Column D
' This is the part that does not work I get:
' Run-time error '5' : Invalid procedure call or argument
With DestSh.Cells("D2:D")
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
' This statement will copy the sheet names in the C column.
' I have not been able to check this part since I am stock in the previous step
DestSh.Cells("C2:C").Resize(CopyRng.Rows.Count).Value = sh.Name
End If
Next
ExitTheSub:
Application.Goto Worksheets("Summary").Cells(1)
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Second Code:
Function LastRow(sh As Worksheet)
On Error Resume Next
LastRow = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
End Function
Function LastCol(sh As Worksheet)
On Error Resume Next
LastCol = sh.Cells.Find(What:="*", _
After:=sh.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
End Function
Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
' Loop through worksheets that start with the name "20"
' This section I tested and it works
For Each sh In ActiveWorkbook.Worksheets
If LCase(Left(sh.Name, 2)) = "20" Then
' Specify the range to copy the data
' This portion has also been tested and it works
sh.Range("B2").Copy
' Paste copied range into "Summary" worksheet in Column D
' This is the part that does not work I get:
' Run-time error '5' : Invalid procedure call or argument
Worksheets("Summary").Cells("D2:D").PasteSpecial (xlPasteValues)
' This statement will copy the sheet names in the C column.
' I have not been able to check this part works since I am stock in the previous step
Worksheets("Summary").Cells("C2:C").Resize(CopyRng.Rows.Count).Value = sh.Name
End If
Next
ExitTheSub:
Application.Goto Worksheets("Summary").Cells(1)
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Upvotes: 0
Views: 56
Reputation: 11702
I've made changes to your First code:
Sub CopyRangeFromMultiWorksheets()
Dim sh As Worksheet
Dim wb As Workbook
Dim DestSh As Worksheet
Dim LastRow As Long
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Set wb = ThisWorkbook
Set DestSh = wb.Sheets("Summary")
' Loop through worksheets that start with the name "20"
' This section I tested and it works
For Each sh In ActiveWorkbook.Worksheets
If LCase(Left(sh.Name, 2)) = "20" Then
' Specify the range to copy the data
' This portion has also been tested and it works
sh.Range("B2").Copy
LastRow = DestSh.Cells(Rows.Count, "D").End(xlUp).Row + 1 'find the last row of column "D"
' Paste copied range into "Summary" worksheet in Column D
' This is the part that does not work I get:
' Run-time error '5' : Invalid procedure call or argument
'With DestSh.Cells("D2:D") ----> this line is giving error
With DestSh.Cells(LastRow, 4) '----> 4 is for Column "D"
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
Application.CutCopyMode = False
End With
' This statement will copy the sheet names in the C column.
' I have not been able to check this part since I am stock in the previous step
LastRow = DestSh.Cells(Rows.Count, "C").End(xlUp).Row + 1 'find the last row of column "C"
'DestSh.Cells("C2:C").Resize(CopyRng.Rows.Count).Value = sh.Name ----> this line is giving error
DestSh.Cells(LastRow, 3).Value = sh.Name '----> 3 is for Column "C"
End If
Next
ExitTheSub:
Application.Goto Worksheets("Summary").Cells(1)
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Upvotes: 1