Sub Testing()
Dim Target_Workbook As Workbook
Dim Source_Workbook As Workbook
Dim Target_Path As String
Target_Path = "Sample.xlsx"
Set Target_Workbook = Workbooks.Open(Target_Path)
Set Source_Workbook = ThisWorkbook
Source_data = Source_Workbook.Sheets(1).Range("A1:Y74").Copy
Target_Workbook.Sheets(1).Range("A1").Activate
Source_Workbook.Save
Target_Workbook.Save
Target_Workbook.Close False
MsgBox "Task Completed"
End Sub
use below code, populate your source and target excel file names and call this code
Sub CopyWorkbook(Sourceworkbook, TargetWorkbook)
Dim sh As Worksheet, wb As Workbook, wbSource As Workbook
Dim SourcefileName As String
SourcefileName = Sourceworkbook
Set wbSource = Workbooks.Open(Sourceworkbook)
Set wb = Workbooks(TargetWorkbook)
For Each sh In Workbooks(SourcefileName).Worksheets
sh.Copy After:=wb.Sheets(wb.Sheets.count)
Next sh
wbSource.Close
End Sub
e.g TargetWorkbook = "TwoSheet_Compare V2.0.xlsm" and
SourceWorkbook = "sourceFile.xlsx"
Related
I am basically copying one excel file sheet to a particular sheet of the excel file(same file as where I am writing the macro).I get the error- Run time error '9': Subscript out of range on the line WbTarget.Sheets("FPP").Range("A1:E654").PasteSpecial
I am not that good in VBA-any help please?
Sub XMLR()
Dim output As String
output = CreateObject("WScript.Shell").Exec("R CMD BATCH filepath.R").StdOut.ReadAll
Call XML
End Sub
Sub XML()
Dim wbTarget
Dim wbThis
Dim strName
Set wbThis = Workbooks.Open("file.xlsx")
wbThis.Activate
strName = ActiveSheet.Name
Set wbTarget = ActiveWorkbook
Application.CutCopyMode = False
wbThis.Sheets("Sheet1").Range("A1:E654").Copy
wbTarget.Sheets("FPP").Range("A1:E654").PasteSpecial
Application.CutCopyMode = False
wbTarget.Save
wbTarget.Close
wbThis.Close
Set wbTarget = Nothing
Set wbThis = Nothing
End Sub
Slightly confusing, but try this:
Sub XML()
Dim wbTarget As Workbook
Dim wbThis As Workbook
Dim strName As String
Set wbThis = Workbooks.Open("file.xlsx")
ThisWorkbook.Sheets("FPP").Range("A1:E654").Value = wbThis.Sheets("Sheet1").Range("A1:E654").Value
wbTarget.Save
wbTarget.Close
wbThis.Close
Set wbTarget = Nothing
Set wbThis = Nothing
End Sub
The issue here is that both WbTarget and WbThis refer to the same workbook.
You should change you declaration:
Set wbTarget = ActiveWorkbook
to
Set wbTarget = Application.ThisWorkbook
I am getting run-time error '2147 and for the life of me I can't see what I am missing.
All I am trying to do is from my current workook open a selected workbook and copy in all sheets.
Thank you.
Sub GetFile()
Dim fNameAndPath As Variant
Dim wb As Workbook, wb2 As Workbook
Dim Ws As Worksheet
fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="Select File To Be Opened")
If fNameAndPath = False Then Exit Sub
Workbooks.Open Filename:=fNameAndPath
Application.ScreenUpdating = False
Set wb = ActiveWorkbook
Set wb2 = Workbooks.Add(fNameAndPath)
For Each Ws In wb2.Worksheets
Ws.Copy After:=wb.Sheets(wb.Sheets(1))
Next Ws
Application.ScreenUpdating = True
End Sub
Public Sub this()
Dim path As String, fileName As String
Dim sheet As Worksheet, thisWB As Workbook, thatWB As Workbook
Dim arr() As Variant
Dim rowC As Long, colC As Long
path = "C:\Users\dcoats\Desktop" & "\"
fileName = Dir(path & "*.xl??")
Set thisWB = ThisWorkbook
Do While Len(fileName) > 0
Set thatWB = Workbooks.Open(path & fileName, True, True)
For Each sheet In thatWB.Sheets
arr = sheet.UsedRange
rowC = sheet.UsedRange.Rows.Count
colC = sheet.UsedRange.Columns.Count
thisWB.Sheets.Add After:=Worksheets(Worksheets.Count)
thisWB.ActiveSheet.Range(thisWB.ActiveSheet.Cells(1, 1), thisWB.ActiveSheet.Cells(rowC, colC)).Value2 = arr
Next sheet
thatWB.Close False
fileName = Dir()
Loop
End Sub
This should work for you. Careful though it loops through all files in a directory (sorry I basically copied/pasted this from a script library i keep).
I am running a code that aims to pull in data from all workbooks within a specific folder. I have written the code for the loop separate from the code for the pulling in of data.
Sub FixedIncomeLoop()
Dim file As Variant
Dim wb1 As Workbook
Dim wb2 As Workbook
Dim folderpath As String
Dim ws As Worksheet
Dim ws2 As Worksheet
Set wb1 = ActiveWorkbook
Set ws = ActiveSheet
folderpath = "C:\Users\Wei Hong\Documents\Trade Tickets\"
file = Dir(folderpath)
While (file <> "")
Set wb2 = Workbooks.Open(file)
Set ws2 = wb2.Worksheets("Trade Ticket")
Call FixedIncome(wb1, ws, ws2)
wb2.Close SaveChanges:=False
Set wb2 = Nothing
Wend
End Sub
Private Sub FixedIncome(wb1 As Workbook, ws As Worksheet, ws2 As Worksheet)
Dim ws3 As Worksheet
Set ws3 = wb1.Worksheets("Constants") <-- facing error
ws.Activate
...
End Sub
I am facing the runtime error above. Not sure why!
I like to compare two workbooks with different sheet, How can I set as an object for workbook1-->Sheet1 , workbook2--->(sheet1)
I can able to compare the worksheet inside the same workbook, Butwhere as if I want to select the sheet the "getopenfilename". how can i assign the name as an object.
code:
Dim tabWb As Workbook 'Workbook2
Dim tabWS As Worksheet 'analysing worksheet
Filename = Application.GetOpenFilename("Excel files (*.xls*),*.xl*", Title:="Open data")
Set wb = ActiveWorkbook
Set tabWS = Sheets("Tabelle1")
Dim bsmWS As Worksheet ' workbook1
Set bsmWS = Sheets("Sheet1") ' currentworksheet
Workbook1(sheet1) is my current workbook and work sheet, I like to get some data from the another workbook2(sheet1). How can i make an object for the both worksheets.I am getting compileing failure in "set bsmws"
Sub test()
Dim strFileName as String
Dim wbTarget As Workbook
Dim wbSource As Workbook
Dim wsTarget As Worksheet
Dim wsSource As Worksheet
strFileName = Application.GetOpenFilename("Excel files (*.xls*),*.xl*", Title:="Open data")
Set wbSource = ThisWorkbook
Set wbTarget = Workbooks.Open(strFileName)
Set wsSource = wbSource.Worksheets("Sheet1")
Set wsTarget = wbTarget.Worksheets("Sheet1")
'to copy from Target - > Source
wsTarget.Range("B2").Resize(5, 5).Copy wsSource.Range("B2")
'etc.
End Sub
The Excel hang if the user click the button in the sheet. The button allowed the user to run the following VBA code. If the user runs the code from VBA editor, it's working fine. Kindly help. The code is as the following. I'm trying to copy data from current excel file to the other excel file newly created.
Sub clickBreak()
i = 12
Dim workBookName As String
Dim workBookName2 As String
Dim wb2 As Workbook
Dim wb1 As Workbook
Dim pasteStart As Range
workBookName = Application.ActiveWorkbook.FullName
workBookName2 = Insert(workBookName, "_2", InStr(workBookName, ".xls") - 1) & ".xls"
MsgBox workBookName2
Dim xlobj As Object
Set xlobj = CreateObject("Scripting.FileSystemObject")
xlobj.CopyFile workBookName, workBookName2, True
Set xlobj = Nothing
Set wb1 = Workbooks.Open(Filename:=workBookName)
Set pasteStart = [A12:A15]
wb1.Sheets("contents").Range("A12:A15").Copy
Set wb2 = Workbooks.Open(Filename:=workBookName2)
wb2.Sheets("contents").Range("A12:A:15").PasteSpecial xlPasteAll
wb2.Save
End Sub
clickBreak is not an event handler. If the name of your button is Break you must name the sub
BreaK_Click() for it to act as an event handler for the button click event:
Sub BreaK_Click()
...
End Sub
Full Code:
Sub BreaK_Click()
i = 12
Dim workBookName As String
Dim workBookName2 As String
Dim wb2 As Workbook
Dim wb1 As Workbook
Dim pasteStart As Range
workBookName = Application.ActiveWorkbook.FullName
workBookName2 = Insert(workBookName, "_2", InStr(workBookName, ".xls") - 1) & ".xls"
MsgBox workBookName2
Dim xlobj As Object
Set xlobj = CreateObject("Scripting.FileSystemObject")
xlobj.CopyFile workBookName, workBookName2, True
Set xlobj = Nothing
Set wb1 = Workbooks.Open(Filename:=workBookName)
Set pasteStart = [A12:A15]
wb1.Sheets("contents").Range("A12:A15").Copy
Set wb2 = Workbooks.Open(Filename:=workBookName2)
wb2.Sheets("contents").Range("A12:A:15").PasteSpecial xlPasteAll
wb2.Save
End Sub
I got the answer
Sub clickBreak()
Dim workBookName As String
Dim workBookName2 As String
Dim wbTarget As Workbook
Dim wbThis As Workbook
Dim strName As String
Set wbThis = ActiveWorkbook
strName = ActiveSheet.Name
workBookName = Application.ActiveWorkbook.FullName
workBookName2 = Insert(workBookName, "_2", InStr(workBookName, ".xls") - 1) & ".xls"
Dim xlobj As Object
Set xlobj = CreateObject("Scripting.FileSystemObject")
xlobj.CopyFile workBookName, workBookName2, True
Set xlobj = Nothing
Set wbTarget = Workbooks.Open(workBookName2)
wbTarget.Sheets("contents").Range("A1").Select
wbTarget.Sheets("contents").Range("A12:A15").ClearContents
wbThis.Activate
Application.CutCopyMode = False
wbThis.Sheets("contents").Range("A12:A15").Copy
wbTarget.Sheets("contents").Range("A12:A15").PasteSpecial
Application.CutCopyMode = False
wbTarget.Save
wbTarget.Close
wbThis.Activate
'clear memory
Set wbTarget = Nothing
Set wbThis = Nothing
End Sub
Thanks you for spending time on my question and giving feedback. Sorry for answering my own question, I just want to share my resolution with the other who will be having the same problem.
I got reference from this http://en.kioskea.net/faq/24666-excel-vba-copy-data-to-another-workbook