Copy method of worksheet class failed Error

[khawarameer]

Dear All,

I was using the below mentioned code to combine several workbooks in single worksheet. However recently i copied this code in my personal macro book (personal.xlsb) and when i run this code from macro option it gives me "Run Time Error 1004" "Copy method of Worksheet class failed".

Can any one help?

Sub Combined_Sheets()

Path = "C:\Users\bal-admin\Desktop\DMS CLG\"

Dim NumSheets As Integer
Dim NumRows As Double
Dim wks As Worksheet

Dim number As Integer
number = 1
Filename = Dir(Path & "*.*")
Do While Filename <> ""
Workbooks.Open Filename:=Path & Filename, ReadOnly:=True, CorruptLoad:=xlRepairFile
For Each Sheet In ActiveWorkbook.Sheets
ActiveSheet.Name = number
Sheet.Copy After:=ThisWorkbook.Sheets(1)
number = number + 1
Next Sheet
Workbooks(Filename).Close savechanges:=False
Filename = Dir()
Loop

Application.DisplayAlerts = False
ThisWorkbook.Worksheets("Sheet1").Delete
Application.DisplayAlerts = True

NumSheets = ActiveWorkbook.Worksheets.Count

Worksheets(1).Select
Sheets.Add
ActiveSheet.Name = "Consolidated"
For x = 1 To NumSheets
Worksheets(x + 1).Select
Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
Worksheets("Consolidated").Select
ActiveSheet.Paste

ActiveCell.SpecialCells(xlLastCell).Offset(1, 0).Select
Selection.End(xlToLeft).Select
Selection.End(xlToLeft).Select

Worksheets(x + 1).Select
Range("A1").Select
Next x
Worksheets("Consolidated").Select
Range("A1").Select

Application.DisplayAlerts = False

For Each wks In Worksheets
If wks.Name <> "Consolidated" Then wks.Delete
Next wks

Application.DisplayAlerts = True

End Sub

 

[AlphaFrog]

The ThisWorkbook keyword refers to the workbook that contains the VBA code. This is now your Personal.xlsb file. That shouldn't be the destination workbook for the copied sheets.

At the start of the macro, declare and set a Workbook variable to the active workbook.

[COLOR=darkblue]Sub[/COLOR] Combined_Sheets()

Path = "C:\Users\bal-admin\Desktop\DMS CLG\"

[COLOR=darkblue]Dim[/COLOR] NumSheets [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Integer[/COLOR]
[COLOR=darkblue]Dim[/COLOR] NumRows [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Double[/COLOR]
[COLOR=darkblue]Dim[/COLOR] wks [COLOR=darkblue]As[/COLOR] Worksheet
[B][COLOR=darkblue]Dim[/COLOR] wb [COLOR=darkblue]As[/COLOR] Workbook

[COLOR=darkblue]Set[/COLOR] wb = ActiveWorkbook[/B]

Then replace the two ThisWorkbook references with wb

ws.Copy After:=wb.Sheets(1)

wb.Worksheets("Sheet1").Delete

 

[khawarameer]

Thank you very much AlphaFrog for your kind explanation and code. Now my code is working properly.

Best regards

Khawarameer