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

How to fill five years of quarters?
Type 1Q-2023 in a cell. Grab the fill handle and drag down or right. After 4Q-2023, Excel will jump to 1Q-2024. Dash can be any character.
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

R
  • Question Question
cells.find error handling
2
Replies
13
Views
604
jolivanes
jolivanes
L
  • Locked
  • Question Question
Macros and protecting a cell
Replies
5
Views
114
Fluff
Fluff
A
  • Solved
Find Row where Col is x and Val is y
Replies
3
Views
139
AlexanderBB
A
T
  • Question Question
Apply macro to all work sheets
Replies
3
Views
416
MARK858
MARK858
L
  • Question Question
How to loop to find and replace with the specific cells
Replies
2
Views
339
Linda Lo
L

Forum statistics

Threads
1,224,819
Messages
6,181,153
Members
453,021
Latest member
Justyna P

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