Copy from one workbook and paste into another

Hi Sirs,

I have written the following code to use is it for frequently paste special/value method of class has failed.

 
Dim wbsurc As Workbook, wbdest As Workbook, flpath As String

'to Open both workbooks: 

Set wbsurc = Workbooks.Open(" C:\1. D Drive\2 - Wrokshop\2 - Working\Vendor List\&Master AML&.xlsb")
Set wbdest = Workbooks.Open(" C:\1. D Drive\2 - Wrokshop\2 - Working\Vendor List\"".xlsb")

'flpath = wbsurc.Path & "\"

'Now, copy from source book:
wbsurc.Sheets("Vend list").Range("A1:C6880").Copy

'Now, paste to target workbook/sheet:

wbdest.Sheets("vend").Range("A1").PasteSpecial

'Close x:
wbsurc.Close
End Sub

Open in new window


Plz help me to fix this plz

thx
M Zahid
LVL 1
M ZahidAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

ShumsExcel & VBA ExpertCommented:
Hi Zahid,

You don't need to open Destination Workbook if you are running code from it: Try below code and let me know
Sub CopyPaste()
 
Dim WBSurc As Workbook, WBDest As Workbook, flpath As String
Dim WSSurc As Worksheet, WSDest As Worksheet

'to Open both workbooks:

flpath = "C:\1. D Drive\2 - Wrokshop\2 - Working\Vendor List"
Set WBSurc = Workbooks.Open(flpath & "\Master AML.xlsb")
Set WBDest = ThisWorkbook
Set WSSurc = WBSurc.Worksheets("Vend list")
Set WSDest = WBDest.Worksheets("vend")

'Now, copy from source book:
WSSurc.Range("A1:C6880").Copy
WSDest.Range("A1").PasteSpecial xlPasteValues

'Close x:
Application.DisplayAlerts = False
WBSurc.Close SaveChanges:=False
Application.DisplayAlerts = True
End Sub

Open in new window

M ZahidAuthor Commented:
Hi Shums,

Thanks is running fine, but I don’t want the file path to be hardcoded its shd read as same folder (flpath & "\Master AML.xlsb") if not then  open the source file then close will be fine.



Thx
ShumsExcel & VBA ExpertCommented:
Hi Zahid,

Try below, which will open a file dialogue box to select the source file:
Sub UpdateDestWB()
Dim DestWB As Workbook, SourceWB As Workbook
Dim DestWs As Worksheet, SourceWs As Worksheet
Dim FolderPath As String, Filter As String, Caption As String, SourceFName As String

'Define Variables
Set DestWB = ThisWorkbook
Set DestWs = DestWB.Worksheets("vend")
FolderPath = Application.ThisWorkbook.Path
ChDir FolderPath
Filter = "Text files (*.xl*),*.xl*"
Caption = "Please Select a Source File "
SourceFName = Application.GetOpenFilename(Filter, , Caption)

'Cancel Exit
If SourceFName = False Then Exit Sub
On Error GoTo ErrorHandler

'Disable Events
With Application
    .ScreenUpdating = False
    .DisplayStatusBar = True
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

Set SourceWB = Application.Workbooks.Open(SourceFName, Format:=xlDelimited, Local:=True)
Set SourceWs = SourceWB.Worksheets("Vend list")

'Copy Paste Data
SourceWs.Range("A1:C6880").Copy
DestWs.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False

'Close Source Workbook
Application.DisplayAlerts = False
SourceWB.Close SaveChanges:=False
Application.DisplayAlerts = True

DestWs.Activate
DestWs.Range("A1").Activate

'Enable Events
ErrorHandler:
With Application
    .ScreenUpdating = True
    .DisplayStatusBar = True
    .StatusBar = False
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
M ZahidAuthor Commented:
Thx for ur help Shumas
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Applications

From novice to tech pro — start learning today.