I Am getting an error 1004 Application-defined or object-defined . please answer me how to      remove this error and execute my programe.

rimmy
rimmy used Ask the Experts™
on
My code is:
In Module 1-

Sub copyDataFromMultipleWorkbook()
Dim FolderPath As String
Dim Filepath As String, Filename As String
FolderPath = "C:\Myprg\"

Filepath = "*data1.xlsx*"

Filename = Dir(Filepath)

Dim lastrow As Long, lastcolumn As Long

Do While Filename <> ""
Workbooks.Open (FolderPath & Filename)

lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column

Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close

erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 4))

Filename = Dir
Loop
Application.DisplayAlerts = True
End Sub

In Module 2-

Sub cpyDataFromMultipleWorkbook()

Dim FolderPath As String
Dim Filepath As String, Filename As String

FolderPath = "C:\Myprg\"

Filepath = "*data2.xlsx*"

Filename = Dir(Filepath)

Dim lastrow As Long, lastcolumn As Long

Do While Filename <> ""
Workbooks.Open (FolderPath & Filename)

lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column

Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close

erow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range(Cells(erow, 1), Cells(erow, 4))

Filename = Dir

Loop
Application.DisplayAlerts = True
End Sub
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Commented:
Please solve my problem:
error 1004 (Application defined or Object defined error)
My code:
In Module1:

Sub copyDataFromMultipleWorkbook()
Dim FolderPath As String
Dim Filepath As String, Filename As String
FolderPath = "C:\Myprg\"

Filepath = "*data1.xlsx*"

Filename = Dir(Filepath)

Dim lastrow As Long, lastcolumn As Long

Do While Filename <> ""
Workbooks.Open (FolderPath & Filename)

lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column

Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close

erow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet1").Range(Cells(erow, 1), Cells(erow, 4))

Filename = Dir
Loop
Application.DisplayAlerts = True
End Sub

In Module 2:

Sub cpyDataFromMultipleWorkbook()

Dim FolderPath As String
Dim Filepath As String, Filename As String

FolderPath = "C:\Myprg\"

Filepath = "*data2.xlsx*"

Filename = Dir(Filepath)

Dim lastrow As Long, lastcolumn As Long

Do While Filename <> ""
Workbooks.Open (FolderPath & Filename)

lastrow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = ActiveSheet.Cells(1, Columns.Count).End(xlToLeft).Column

Range(Cells(2, 1), Cells(lastrow, lastcolumn)).Copy
Application.DisplayAlerts = False
ActiveWorkbook.Close

erow = Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range(Cells(erow, 1), Cells(erow, 4))

Filename = Dir

Loop
Application.DisplayAlerts = True
End Sub

Author

Commented:
please  reply soon I don't Know how remove this error.
The Programe is I want to copy : File1 to sheet1 of master file &
                                                           File2 to sheet2 of Master file.
My error is comming here
ActiveSheet.Paste Destination:=Worksheets("Sheet2").Range(Cells(erow, 1), Cells(erow, 4))

=> i wrote thi code also:
Private Sub Workbook_Open()

copyDataFromMultipleWorkbook
 
    cpyDataFromMultipleWorkbook

End Sub

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial