[Macro] [VBA] More than One Reference Workbooks to copy cells to a One Workbook / Macro

ozan efendi

New Member
Joined
Nov 6, 2012
Messages
17
Hi, i have Book1 (reference workbook) and Book2 (where i copy values from Book1)

Now i have i macro which helps me to fetch the datas and paste the values in the format below.

But i can only doing this for one reference workbooks. But i need to add more reference workbooks in a file and paste to Book2. (etc: Book1, Book3, Book4, ....... to Book2)

Book2 looks like:

A1 B1 C1 D1


Name Adress Age Sex

Ozan xxxxxx 27 M

Here' s the Code.

Regards,

Ozan.

Option Explicit


Sub TransferData()
Dim wkb As Workbook, wks As Worksheet, LastRow As Long
Dim FilePath As String, FileName As String
Dim ws As Worksheet, blnOpened As Boolean
'Change these variables as desired...
FilePath = "C:\Users\ozzy\Desktop\vba\" 'this is my path
' FilePath = "C:\YourFullFilePathHere\" 'change path here
FileName = "Book2.xlsm" 'change name here
Call ToggleEvents(False)
Set ws = Workbooks.Open(FilePath & "Book1.xlsx").Sheets("Sheet1")
'Set ws = Workbooks.Open(FilePath & "Book1.xlsx").Sheets("Sheet1") 'change source sheet name here
If WbOpen(FileName) = True Then
Set wkb = Workbooks(FileName)
blnOpened = False
Else
If Right(FilePath, 1) <> Application.PathSeparator Then
FilePath = FilePath & Application.PathSeparator
End If
Set wkb = Workbooks(FilePath & "Book1.xlsx")
blnOpened = True
End If
Set wks = wkb.Sheets("Sheet1") 'change destination sheet name here
LastRow = wks.Cells.Find(what:="*", after:=wks.Cells(1, 1), searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1
wks.Cells(LastRow, "A").Value = ws.Cells(1, "B").Value
wks.Cells(LastRow, "B").Value = ws.Cells(4, "B").Value
wks.Cells(LastRow, "C").Value = ws.Cells(7, "B").Value
wks.Cells(LastRow, "D").Value = ws.Cells(7, "E").Value
If blnOpened = True Then
wkb.Close SaveChanges:=True
End If
Call ToggleEvents(True)
End Sub






Sub ToggleEvents(blnState As Boolean)
'Originally written by firefytr
With Application
.DisplayAlerts = blnState
.EnableEvents = blnState
.ScreenUpdating = blnState
If blnState Then .CutCopyMode = False
If blnState Then .StatusBar = False
End With
End Sub


Function WbOpen(wbName As String) As Boolean
'Originally found written by Jake Marx
On Error Resume Next
WbOpen = Len(Workbooks(wbName).Name)
End Function
 

Some videos you may like

Excel Facts

How to create a cell-sized chart?
Tiny charts, called Sparklines, were added to Excel 2010. Look for Sparklines on the Insert tab.

Watch MrExcel Video

Forum statistics

Threads
1,102,042
Messages
5,484,353
Members
407,437
Latest member
alfaroM

This Week's Hot Topics

  • Finding issue in If elseif else with For each Loop
    Finding issue in If elseif else with For each Loop I have tried this below code but i'm getting in Y column filled with W005. Colud you please...
  • MsgBox Error
    Hi Guys, I have the below error show up when i try and run my macro in File1 but works fine if i copy and paste the same code into file2. [ATTACH...
  • CELL FORMAT - IF CONDITION
    My Cell Format is [B]""0.00" Cr". [/B]But in the cell, it is showing 123.00 for editing. (123 is entry figure). (Data imported from other...
  • Show numbers nearly the same
    Is this possible. I have a number that can change very time eg 0.00001234 Then I have a lot of numbers 0.0000001, 0.0000002, 0.00000004...
  • Please i need your help to create formula
    I need a formula in cell B8 to do this >>if b1=1 then multiply ( cell b8) by 10% ,if b1=2 multiply by 20%,if=3 multiply by 30%. Thank you in...
  • Got error while adding column and filter
    Got error while adding column and filter In column Z has some like "Success" and "Error". I want to add column in AA if the Z cell value is...
Top