I have a number of scripts that are in a module in my Personal.xlsb file. It's kept hidden, but in this script, the idea is that you run it from within a different workbook each time. It opens a separate workbook (source.xlsx), copies a range from it, pastes into the original workbook, and then closes source.xlsx.
When it comes to the "ThisWorkbook.ActiveSheet.Paste" part, it's pasting it into the Personal.xlsb workbook instead of the target workbook that is actually open and visible. How can I make sure it's being pasted in the right workbook? The workbook's filename will always be different, so I can't specify a path or anything like that.
Sub CopyData()
Application.DisplayAlerts = False
Dim wbSource As Workbook
Set wbSource = Workbooks.Open(Filename:="source.xlsx", UpdateLinks:=3)
wbSource.Sheets(1).Range("A1:X105").Copy
ThisWorkbook.ActiveSheet.Paste
wbSource.Close
Application.DisplayAlerts = True
Call CopyCFormat
End Sub
Don't use ThisWorkbook in most cases, as it references the workbook that the macro is stored in (in this case, personal.xlsb).
Instead, you can use ActiveWorkbook to refer to whichever workbook has focus at the time the macro is run. You can also assign ActiveWorkbook to a variable for easier reference.
Sub CopyData()
Application.DisplayAlerts = False
Dim wbSource As Workbook
Dim wbTarget as Workbook
Set wbTarget = ActiveWorkbook
Set wbSource = Workbooks.Open(Filename:="source.xlsx", UpdateLinks:=3)
wbSource.Sheets(1).Range("A1:X105").Copy
wbTarget.ActiveSheet.Paste
wbSource.Close
Application.DisplayAlerts = True
Call CopyCFormat
End Sub
You could also reference the active sheet without specifying which workbook it's in, as:
Dim wbSource As Workbook
Dim shtTarget as Worksheet
Set shtTarget = ActiveSheet
Set wbSource = Workbooks.Open(Filename:="source.xlsx", UpdateLinks:=3)
wbSource.Sheets(1).Range("A1:X105").Copy
shtTarget.ActiveSheet.Paste
Luck!
If I understand it, you should just add another workbook variable.
Sub CopyData()
Dim mainWB As Workbook
Dim mainWS As Worksheet
Set mainWB = ActiveWorkbook
Set mainWS = mainWB.Sheets(1) ' Change this to whatever you need it to be
Application.DisplayAlerts = False
Dim wbSource As Workbook
Set wbSource = Workbooks.Open(Filename:="source.xlsx", UpdateLinks:=3)
wbSource.Sheets(1).Range("A1:X105").Copy
mainWS.Paste
wbSource.Close
Application.DisplayAlerts = True
Call CopyCFormat
End Sub
Related
I want to be able to select a workbook and then copy the content from that workbook (sheet 1) into my current active workbook where I run the macro. I've been looking at some answers here on StackOverflow to similar questions and got the following code (see below).
The selection of a file is currently working fine, but when I run the macro it throws an error
Runtime error "438": Object does not support that method or property`
(please note, that the error comes in my native language and is just translated by me)
Sadly no object is marked that he relates to, so I can't really make out what problem he has. Yet, I guess it is a problem with the PasteSpecial in the last line of function GetTemplateData, but that code should be alright (what is it supposed to do? Save the data into the first sheet of the give workbook activeWorkbook) and pass the reference back go GeneratedValues-routine.
Option Explicit
Private Sub GenerateValues()
'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
Dim activeWorkbook As Workbook
Dim activeWorksheet As Worksheet
Set activeWorkbook = Application.activeWorkbook
Set activeWorksheet = GetTemplateData(activeWorkbook)
activeWorkbook.Save
End Sub
'Get The Template Data
Private Function GetTemplateData(activeWorkbook As Workbook) As Worksheet
Dim templateWorkbook As Workbook
'Grab the Template Worksheet
Set templateWorkbook = UseFileDialogOpen
'Select all Content
Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Copy
'activeWorkbook.Sheets(activeWorkbook.Sheets.Count).Range("A1", Cells.End(xlDown) & Cells.End(xlRight)).PasteSpecial xlPasteValues
activeWorkbook.Sheets(1).Range("A1", Cells.End(xlDown) & Cells.End(xlRight)).PasteSpecial xlPasteValues
End Function
'From https://learn.microsoft.com/de-de/office/vba/api/excel.application.filedialog
'Select the Workbook containing the Exported Template-Stories by User Selection
Function UseFileDialogOpen() As Workbook
Dim lngCount As Long
Dim filePath As String
Dim templateBook As Workbook
' Open the file dialog
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = False
.Show
Set templateBook = Workbooks.Open(.SelectedItems(1))
' Display paths of each file selected
'For lngCount = 1 To .SelectedItems.Count
' MsgBox .SelectedItems(lngCount)
'Next lngCount
End With
templateBook
End Function
I believe all of your problems originate here:
Private Sub GenerateValues()
'Application.ScreenUpdating = False
'Application.DisplayAlerts = False
Dim activeWorkbook As Workbook
Dim activeWorksheet As Worksheet
Set activeWorkbook = Application.activeWorkbook
Set activeWorksheet = GetTemplateData(activeWorkbook)
activeWorkbook.Save
End Sub
ActiveWorkbook is a defined "variable" in VBA, so it is confused as to why you are trying to reassign it. Try using a different variable name instead.
Note: although ActiveWorksheet is not a defined variable in VBA, it is close in name to ActiveSheet, so I would also change that variable name to something different just so to not confuse you when writing future code.
You could try something similar to this:
Sub CopyContentsFromOtherWorkbook()
Dim wb As Workbook
Dim twb As Workbook
filePath = "C:\File.xlsx"
Set wb = Workbooks.Open(filePath)
wb.Sheets(1).Range("A1:Z10000").Copy
Set twb = ThisWorkbook
twb.Sheets(1).Range("C1").PasteSpecial xlPasteValues
wb.Close
twb.Save
End Sub
I'm working on a macro that will move a sheet from a selected Excel sheet into a document with a macro already loaded.
I'm having issues with actually getting the sheet to move over, I keep receiving a subscript out of range error and I'm unsure of why
I've perused stackoverflow and a few other resources so far. I've attempted using .sheets / workbook(workbookname).worksheets(1).copy ...so on and so forth.
Sub runEXCEL()
dim wb1 as workbook, wb2 as workbook
dim fd as filedialog
dim shtpath as string
dim ws as worksheet
Set fd = Application.FileDialog(msoFileDialogFilePicker)
If fd.Show = True Then
If fd.SelectedItems(1) <> vbNullString Then
shtpath = fd.SelectedItems(1)
End If
Else
End
End If
set wb1 = workbooks.open("c:\users\username\documents\yestbook.xlsm", true, false
set wb2 = workbooks.open(shtpath)
set ws = wb2.worksheets(1)
ws.name = "testname"
ws.worksheets(1).copy after:=wb1.sheets(1)
'xl.Application.Run "yestbook.xlsm!findCellAddress"
End Sub
Ideally I would like to copy a sheet from a selected workbook into my predefined workbook.
Subscript out of range occurs because "yestbook.xlsm" does not exist in the global Workbooks collection, which is in this case limited to the active instance of Excel (i.e., the instance from which this code is executed). You've opened two workbooks, each in a new and separate instance of Excel, which presents further problems, because you can't actually Copy worksheets between instances like this.
This should work, unless there are some extraordinary reasons why each file must open in its own instance:
Dim wb1 As Workbook, wb2 as Workbook
Dim fd As FileDialog
Dim shtpath As String
Dim ws As Worksheet
Set fd = Application.FileDialog(msoFileDialogFilePicker)
If fd.Show = True Then
If fd.SelectedItems(1) <> vbNullString Then
shtpath = fd.SelectedItems(1)
End If
Else
End
End If
Set wb1 = Workbooks.Open("C:\Users\username\Desktop\yestbook.xlsm", True, False)
Set wb2 = Workbooks.Open(shtpath)
Set ws = wb2.Worksheets(1)
ws.Name = "testname"
ws.Copy after:=wb1.Sheets(1)
It is not necessary to create additional Excel processes (actually, this might be cause of the problem). You should also use workbook and worksheets variables for all sheet access, and avoid unqualified access like Sheets("testname").
Try something along the lines of:
Dim wb as workbook, ws as worksheet, wb2 as workbook, ws2 as worksheet
Set wb = Workbooks.Open(mysheetpath1)
Set ws=wb.Worksheets(1)
set wb2=Workbooks.Open(mysheetpath2)
set ws2=wb2.Worksheets(1)
ws2.Copy after:=ws
Second to last line - you have
ws.worksheets(1).copy after:=wb1.sheets(1)
This should be
wb.worksheets(1).copy after:=wb1.sheets(1)
it's a typo on the second char
Workbooks.Open "C:\abc.xlsx"
Workbooks("abc").Worksheets("Sheet1").Range("A1:B7").Clear
In the above code I am opening the workbook using Workbooks.Open in first line. In the second line I am accessing the opened workbook using the workbook name.
How can I access the opened workbook without the filename in second line?
(I want to create a function and I don't want to pass both the file paths and filenames separately)
You need to use references and reference the workbook and the sheet for example:
Option Explicit
Sub OpenWorkbook()
Dim wb As Workbook, ws As Worksheet
Set wb = Workbooks.Open("C:\abc.xlsx", UpdateLinks:=False, ReadOnly:=True)
Set ws = wb.Sheets("Sheet1")
ws.Range("A1:B7").ClearContents
End Sub
Note that the parameters on the openworkbook such as Updatelinksand ReadOnly can be modified to True or Falseas you need to.
Create an object of type Excel.Workbook and open the workbook into that.
Like so
Dim w as Excel.Workbook
set w= Workbooks.Open ("C:\abc.xlsx")
and then you can say
w.worksheets.add.....
etc
You can shorten your code:
Option Explicit
Sub OpenWb()
Dim ws As Worksheet
Set ws = Workbooks.Open("C:\abc.xlsx").Worksheets("Sheet1")
With ws '<- Use With Statement to avoid sheet repetition
.Range("A1:B7").ClearContents
End With
End Sub
You can try this
Option Explicit
Sub TEST()
Dim WB As Workbook
Set WB = Workbooks.Open(Filename:="C:\abc.xlsx")
For Each WB In Workbooks
If WB.Name = "abc.xlsx" Then
WB.Worksheets(Sheet1).Range("A1:B7").ClearContents
Exit Sub
End If
Next
End Sub
This code works up through the paste into sheet 2 - I can switch over to the new open workbook and see that it is in copy mode but cannot get it to paste into Sheet2(Test). I have tried both "Sheet2" and "Test" but get
run time error 9: subscript out of range
see snip below
Sub ImportWorksheet999()
Dim Wb1 As Workbook
Dim MainBook As Workbook
'Open All workbooks first:
Set Wb1 = Workbooks.Open("G:\T\TWeir\Prod Ctrl\XML Reports\BDA\BDAREPORTtest.xlsx")
Set MainBook = ActiveWorkbook
'Now, copy what you want from wb1:
Wb1.Sheets("BDA Report").Cells.Copy
'Now, paste to Main worksheet:
MainBook.Sheets("Sheet2").Range("A1").PasteSpecial
'Close Wb's:
Wb1.Close
End Sub
Set Wb1 = Workbooks.Open("G:\T\TWeir\Prod Ctrl\XML Reports\BDA\BDAREPORTtest.xlsx")
Set MainBook = ActiveWorkbook
Opening a file will make it the ActiveWorkbook, so your Wb1 and MainBook both refer to the opened workbook.
Should be
Set MainBook = ActiveWorkbook 'or ThisWorkbook if that's where the code is running
Set Wb1 = Workbooks.Open("G:\T\TWeir\Prod Ctrl\XML Reports\BDA\BDAREPORTtest.xlsx")
I've seen quite a few examples for making a full copy of a worksheet but none of them are working for me. In my case the sheet has to go into a new workbook. In my actual code wb is defined global and the workbook is created in another sub that called this one.
Dim wb As Workbook
Set wb = Workbooks.Add()
Dim newtab as Worksheet
With ActiveWorkbook
.Sheets("Sample Attendance").Copy After:=wb.Sheets(.Sheets.Count)
Set newtab = wb.Sheets(wb.Sheets.Count - 1)
End With
didn't work.
Likewise
ActiveWorkbook.Sheets("Sample Attendance").Copy After:=wb.Sheets(1)
Set newtab = wb.Sheets("Sample Attendance")
newtab.Name = tabname
both methods return after the Copy statement.
I've been moderately successful with this:
Set newtab = wb.Worksheets.Add
newtab.Name = tabname
Set Attendance = ThisWorkbook.Sheets("Sample Attendance")
Attendance.Range("A:BB").Copy Destination:=newtab.Cells(1, 1)
which works. But then I have to copy all of the PageSetup across which is giving me fits and takes forever.
I see two problems with your 1st piece of code...
You are using Activeworkbook. When you add a new workbook, the new workbook becomes your active workbook :)
The second problem is the DOT before .Sheets.Count in wb.Sheets(.Sheets.Count). why pick the count from the workbook you are copying?
Try this
Sub Sample()
Dim thiswb As Workbook, wb As Workbook
Dim newtab As Worksheet
Set thiswb = ThisWorkbook
Set wb = Workbooks.Add()
With thiswb
.Sheets("Sample Attendance").Copy After:=wb.Sheets(wb.Sheets.Count)
Set newtab = wb.Sheets(wb.Sheets.Count - 1)
End With
End Sub
Give this a shot:
Sub SheetCopier()
Dim OriginalWB As Workbook
Dim NewWB As Workbook
Set OriginalWB = ActiveWorkbook
Workbooks.Add
Set NewWB = ActiveWorkbook
OriginalWB.Sheets("qwerty").Copy Before:=NewWB.Sheets(1)
End Sub