CODEWITHSUNDEEP
vbaexcel
Mikz
Mikz

Reputation: 591

Extract data from one workbook and copy to another workbook

I am trying to copy the data from one workbook to another workbook.

I searched through Internet and came up with the below code. there is no error in the code.

The code works fine, but the Problem is, it is opening both the Sheets , but not copying the data in Destination sheet.

in the code below, I have considered x as source sheet and y as Destination sheet.

Could someone suggest, where i am wrong and what is the reason i am not able to copy. 

Sub test()
Dim x As Workbook
Dim y As Workbook
Dim val As Variant
Dim filename As String


Set x = Workbooks.Open("D:\Mikz\xxx.xlsx")

Set y = Sheets("Sheet1").Select
val = x.Sheets("Sheet2").Range("A1").Value
y.Sheets("Sheet1").Range("A1").Value = val

x.Close

End Sub

Upvotes: 0

Views: 386

Answers (2)

Shai Rado
Shai Rado

Reputation: 33672

The reason for your error, lies in the section below:

Dim y As Workbook
Set y = Sheets("Sheet1").Select

You defined y as workbook, but trying to assign a Worksheet object to it, and you added Select for some reason, which is defiantly not recommended.

It should be (if the workbook is open) :

Set y = Workbooks("YourBookName")

The rest of your code would work just fine.

However, reading your post, I think you meant to define y As Worksheet.

And then the rest of your code should be: 

Set y = Sheets("Sheet1")
val = x.Sheets("Sheet2").Range("A1").Value
y.Range("A1").Value = val

Edit 1: Updated code (according to PO's new data)

Option Explicit

Sub test()

Dim x As Workbook
Dim y As Workbook
Dim Val As Variant
Dim filename As String

Set y = ThisWorkbook ' set ThisWorkbook object (where this code lies)
Set x = Workbooks.Open("D:\Mikz\xxx.xlsx")

Val = x.Sheets("Sheet2").Range("A1").Value
y.Sheets("Sheet1").Range("A1").Value = Val

x.Close

End Sub

Edit 2: Code to copy columns A:E till last row with data

Option Explicit

Sub test()

Dim x As Workbook
Dim y As Workbook
Dim Val As Variant
Dim filename As String
Dim LastCell As Range
Dim LastRow As Long

Set y = ThisWorkbook ' set ThisWorkbook object (where this code lies)
Set x = Workbooks.Open("D:\Mikz\xxx.xlsx")    
With x.Sheets("Sheet2")
    ' use the find method to get the last row in column A:E
    Set LastCell = .Columns("A:E").Find(What:="*", After:=.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False)
    If Not LastCell Is Nothing Then ' find was successful
        LastRow = LastCell.Row ' get last Row with data
    End If

    Val = .Range("A1:E" & LastRow).Value ' save range in 2-D array
End With

' resize the range from A1 through column E and the last row with data in copied workbook
y.Sheets("Sheet1").Range("A1").Resize(LastRow, 5).Value = Val

x.Close

End Sub

Upvotes: 1

Plagon
Plagon

Reputation: 3138

Try:

Sub test()
Dim wb As Workbook
Dim sht As Worksheet, sht2 As Worksheet

Set wb = Workbooks.Open("Filename")
Set sht = wb.Worksheets("Sheet2")
Set sht2 = ThisWorkbook.Worksheets("Sheet1")

sht2.Range("A1").Value = sht.Range("A1").Value

wb.Close
End Sub

But it should throw syntax errors and type mismatches before. Dont use .Select, its not necessary for any functions or task, it can be done without.

Upvotes: 0

Related Questions