Run-time ERROR 1004

A

AT BABU

Board Regular
Joined
Oct 12, 2018
Messages
54
Office Version
  1. 2016
Platform
  1. Windows
Hi All
Good day for you........

I Run below code i get run-time error. Please need you help

Code: 
Sub GetFileCopyData()
   Dim Fname As String
   Dim SrcWbk As Workbook
   Dim DestWbk As Workbook


   Set DestWbk = ThisWorkbook


   Fname = Application.GetOpenFilename(FileFilter:="Excel Files (*.xls*), *.xls*", Title:="Select a File")
   If Fname = "False" Then Exit Sub
   Set SrcWbk = Workbooks.Open(Fname)


If Evaluate("isref('Support_Details'!a1)") Then
   Sheets("Support_Details").Select
Cells.Find(What:="Company #", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate


Range(ActiveCell, ActiveCell.End(xlDown)).Copy
DestWbk.Activate
Worksheets("sheet1").Activate
Range("A1").PasteSpecial xlPasteValues


SrcWbk.Activate
Cells.Find(What:="Type of company", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Copy
DestWbk.Activate
Range("b1").PasteSpecial xlPasteValues


SrcWbk.Activate
Cells.Find(What:="Doc ID", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Copy
DestWbk.Activate
Range("c1").PasteSpecial xlPasteValues


SrcWbk.Activate
Cells.Find(What:="QC final remarks (Observation/Not Applicable)", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Copy
DestWbk.Activate
Range("d1").PasteSpecial xlPasteValues


SrcWbk.Activate
Cells.Find(What:="Root Cause", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
 Range(ActiveCell, ActiveCell.End(xlDown)).Copy
DestWbk.Activate
Range("e1").PasteSpecial xlPasteValues


SrcWbk.Activate
Cells.Find(What:="QC doc delivery date", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Copy
DestWbk.Activate
Range("f1").PasteSpecial


SrcWbk.Activate
Cells.Find(What:="CTQ Quality%", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Copy
DestWbk.Activate
Range("g1").PasteSpecial


SrcWbk.Activate
Cells.Find(What:="Document Acceptance", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Copy
DestWbk.Activate
Range("H1").PasteSpecial xlPasteValues
End If


SrcWbk.Activate
If Evaluate("isref('Dummy_prime_Doc details'!a1)") Then
   Sheets("Dummy_prime_Doc details").Select
Cells.Find(What:="Company #", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Offset(1, 0).Copy
DestWbk.Activate
Range("A1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues


SrcWbk.Activate
Cells.Find(What:="Type of company", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Offset(1, 0).Copy
DestWbk.Activate
'''''''Range("b1").PasteSpecial
Range("B1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues


SrcWbk.Activate
Cells.Find(What:="Doc ID", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Offset(1, 0).Copy
DestWbk.Activate
Range("C1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues


SrcWbk.Activate
Cells.Find(What:="QC Comments", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Offset(1, 0).Copy
DestWbk.Activate
''''''''Range("c1").PasteSpecial
Range("D1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues


SrcWbk.Activate
Cells.Find(What:="Root Cause", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
 Range(ActiveCell, ActiveCell.End(xlDown)).Offset(1, 0).Copy
DestWbk.Activate
''''''Range("d1").PasteSpecial
Range("E1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues


SrcWbk.Activate
Cells.Find(What:="QC doc delivery date", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Offset(1, 0).Copy
DestWbk.Activate
''''''Range("e1").PasteSpecial
Range("F1").End(xlDown).Offset(1, 0).PasteSpecial


SrcWbk.Activate
Cells.Find(What:="CTQ Quality%", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Offset(1, 0).Copy
DestWbk.Activate
'''''Range("f1").PasteSpecial
Range("G1").End(xlDown).Offset(1, 0).PasteSpecial


SrcWbk.Activate
Cells.Find(What:="Document Acceptance", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Offset(1, 0).Copy
DestWbk.Activate
''''''''''Range("g1").PasteSpecial
Range("H1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues


End If
SrcWbk.Activate
If Evaluate("isref('New support_Doc_details'!a1)") Then
   Sheets("New support_Doc_details").Select
Cells.Find(What:="Company #", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate


Range(ActiveCell, ActiveCell.End(xlDown)).Offset(1, 0).Copy
DestWbk.Activate
'''''''Range("A1").PasteSpecial
Range("A1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues


SrcWbk.Activate
Cells.Find(What:="Type of company", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Offset(1, 0).Copy
DestWbk.Activate
'''''''''Range("b1").PasteSpecial
Range("B1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues


SrcWbk.Activate
Cells.Find(What:="Doc ID", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Offset(1, 0).Copy
DestWbk.Activate
Range("c1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues


SrcWbk.Activate
Cells.Find(What:="QC final Comments", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Offset(1, 0).Copy
DestWbk.Activate
Range("D1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues




SrcWbk.Activate
Cells.Find(What:="Root Cause", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
 Range(ActiveCell, ActiveCell.End(xlDown)).Offset(1, 0).Copy
DestWbk.Activate
''''''''Range("d1").PasteSpecial
Range("E1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues


SrcWbk.Activate
Cells.Find(What:="QC doc delivery date", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Offset(1, 0).Copy
DestWbk.Activate
''''''''Range("e1").PasteSpecial
Range("F1").End(xlDown).Offset(1, 0).PasteSpecial


SrcWbk.Activate
Cells.Find(What:="CTQ Quality%", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Offset(1, 0).Copy
DestWbk.Activate
'''''''Range("f1").PasteSpecial
Range("G1").End(xlDown).Offset(1, 0).PasteSpecial


SrcWbk.Activate
Cells.Find(What:="Document Acceptance", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False).Activate
Range(ActiveCell, ActiveCell.End(xlDown)).Offset(1, 0).Copy
DestWbk.Activate
'''''''Range("g1").PasteSpecial
Range("H1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
End If
SrcWbk.Close False
Range("A2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
Worksheets("sheet2").Select
Range("A1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecial
End Sub
 
Last edited by a moderator:

Excel Facts

Does the VLOOKUP table have to be sorted?
No! when you are using an exact match, the VLOOKUP table can be in any order. Best-selling items at the top is actually the best.
Sort by date Sort by votes
Which line is causing the error? And what type of error is it?

Maybe Cells.Find isn't finding the data you're searching for. You can test whether the data is found like this...

Code: 
    Dim cellFound As Range
    Set cellFound = Cells.Find(What:="Company #", After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
    If Not cellFound Is Nothing Then
        'do stuff
    End If
 
Upvote 0
Hi Domenic,
Thank you for reply
From this line get error
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Worksheets("sheet2").Select
Range("A1").End(xlDown).Offset(1, 0).Select
Selection.PasteSpecia

Type error
Application-defined or object-error
 
Upvote 0
It looks like what may be happening is that when there's no data in Column A that Range("A1").End(xlDown) finds the last cell in Column A, which would be A1048576. Then the error occurs when you use Offset to select the row below it. Instead, maybe you can find the desired row starting from the bottom up...

Code: 
Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Select

By the way, there's usually no need to do all that selecting and activating. It only slows things down and makes the macro very inefficient. If you want to clean it up, try starting a new thread, post a small part of your code which has all that selecting and activating, and ask someone to help you clean it up.
 
Upvote 0
Thank you for your solution and suggestion
I am learning codeing from last month
Thank you again for your suggestion. I will clean it up myself
 
Upvote 0
You must log in or register to reply here.

Similar threads

F
  • Solved
Looping code sequence
Replies
5
Views
150
FrenchCelt
F
M
  • Locked
  • Question
Sumproduct Formula in VBA
Replies
3
Views
490
Fluff
Fluff
M
  • Question
Excel VBA Set Activecell Formula With String
Replies
1
Views
454
Special-K99
S
A
  • Question
Select range using Endx1Down
Replies
4
Views
356
Peter_SSs
Peter_SSs
P
  • Solved
Add an IF Statement
2
Replies
10
Views
371
Joe4
Joe4

Forum statistics

Threads
1,214,979
Messages
6,122,557
Members
449,088
Latest member
davidcom

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top