Having this, probably easy to solve problem, but without any programing skills its hard for me to crack...
I made an excel file with a button, a macro assigned to it.
What it should do :
Open another xls file, for which the user can search on harddrive
copy every sheet from the opened file
Paste it to the original file and close the one it was copied from.
So far I got this:
Sub Importfile()
Dim sFile As String
Dim wb As Workbook
sFile = Application.GetOpenFilename("*.xls,*.xls")
If sFile <> "False" Then
Set wb = Workbooks.Open(sFile)
'Copy and paste code , where I dont know what to do
wb.Close
End If
End Sub
Your example code is right, looking at the recorded macro code should have shown you how to use the worksheet.copy method. Using that you would just have to loop through all the worksheets in your newly opened workbook and copy them to your original workbook.
I've used a For Each, you could also just a plain For or any other sort of loop that you like.
Sub Importfile()
Dim sFile As String
Dim wb As Workbook
Dim ws As Worksheet
sFile = Application.GetOpenFilename("*.xls,*.xls")
If sFile <> "False" Then
Set wb = Workbooks.Open(sFile)
For Each ws In wb.Worksheets
ws.Copy before:=ThisWorkbook.Worksheets(1)
Next ws
wb.Close
End If
End Sub
The macro works fine for me! Please make sure that you have placed the code in the correct location.
In the image below "Book1" is your original sheet (the one you are copying sheets to) the macro code should be inserted into a "module" (the red square) and not any of the ones in the orange square. If you do not have a "module 1" (or any other) you need to insert a new one by looking in the "insert" menu at the top of the vba editor.
Related
I have a large macro I am amending for my purpose. The writer of the macro was more skilled than me. The macro at present runs formulas on data gathered from websites and other spreadsheets.
All I want to do is to have "Red Flagged" ranges copied and pasted into a the same new workbook. Can this be done without having to save the new work book?
Here was my initial idea:
Sub CreateNewWB()
With Application
.SheetsInNewWorkbook = 1
.Workbooks.Add
.Sheets(1).Name = "Late"
End With
Set ptrToLate = Application.ActiveSheet.FullName
' MsgBox ("This workbook has name" & Application.ActiveWorkbook.Name)
'MsgBox ("This workbook has Full name" & Application.ActiveWorkbook.FullName)
' MsgBox ("This workbook has path name" & Application.ActiveWorkbook.Path)
' MsgBox ("This workbook has Code name" & Application.ActiveWorkbook.CodeName)
End Sub
At the very top of the VBA code I had put
Dim ptrToLate as String
with the intentions of being able to copy and paste using the new workbooks name as a destination, but I get the error: "Object doesnt support this property or method"
1) Is there a way to append to an unsaved workbook?
2)presently the codename of the new workbook is "thisWorkbook" this confuses me because I thought that thisworkbook referred to the workbook the macros itself is written in
Thank you in advance for your help
All you need to do is set the new workbook to an object and then you can reference it without the path. The variable wrkb will now reference your destination new workbook.
Dim wkb As Workbook
'Adding New Workbook
Set wrkb = Workbooks.Add(1) 'this creates anew workbook with only 1 sheet
wrkb.Sheets(1).Name = "Late"
Workbook("Red Flagged.xlsx").Sheets("redflagged").Range("A1:D2").Copy wrkb.Sheets("Late").Range("A1")
To the question in the title: VBA when pasting into separate workbook must I save the workbook to get the path first?
The answer is YES
If you open a new workbook and write this in the VBEditor, you would see that there would an empty MsgBox. If you save it and then run the code again, the path would be shown:
Public Sub TestMe()
MsgBox ThisWorkbook.Path
End Sub
So I have a worksheet that generates a chart type of thing using information on 2 other worksheets. On It I have an extract button which should copy the entire workbook into a new workbook whilst making the sheets where the data is pulled from invisible to the user. My issue is, the chart worksheet has other features which require macros to be run, for example buttons that hide some of it etc. The issue is I cannot find whether its actually possible to copy through macros from a workbook into the new copied workbook? Anyone have an answer to this and if so, how would you do this? Here is the code I currently have which copies the workbook into a new workbook:
Sub EWbtn()
Dim OriginalWB As Workbook, NewCRCWB As Workbook
Set OriginalWB = ThisWorkbook
Set NewCRCWB = Workbooks.Add
OriginalWB.Sheets("Generator").Copy Before:=NewCRCWB.Sheets("Sheet1")
OriginalWB.Sheets("Module Part Number Tracker").Copy Before:=NewCRCWB.Sheets("Generator")
OriginalWB.Sheets("CRC").Copy Before:=NewCRCWB.Sheets("Module Part Number Tracker")
Application.DisplayAlerts = False
NewCRCWB.Worksheets("Generator").Visible = False
NewCRCWB.Worksheets("Module Part Number Tracker").Visible = False
NewCRCWB.Worksheets("Sheet1").Delete
Application.DisplayAlerts = True
End Sub
I'd take a copy of the original file and delete/hide sheets from that.
All code is copied over as part of the save.
Sub Test()
Dim wrkBk As Workbook
Dim sCopyFileName As String
Dim wrkSht As Worksheet
sCopyFileName = "C:\MyFolderPaths\Book2.xlsm"
'Create copy of original file and open it.
ThisWorkbook.SaveCopyAs (sCopyFileName)
Set wrkBk = Workbooks.Open(sCopyFileName)
'wrkbk.Worksheets does not include Chart sheets.
'wrkbk.Sheets would take into account all the types of sheet available.
For Each wrkSht In wrkBk.Worksheets
Select Case wrkSht.Name
Case "Generator", "Module Part Number Tracker"
wrkSht.Visible = xlSheetVeryHidden
Case "CRC"
'Do nothing, this sheet is left visible.
Case Else
Application.DisplayAlerts = False
wrkSht.Delete
Application.DisplayAlerts = True
End Select
Next wrkSht
wrkBk.Close SaveChanges:=True
End Sub
I managed to find an answer to my question.. This code works fine however you need to add "Microsoft Visual Basic for Applications Extensibility 5.x" as a reference via Tools -> References. Here is the code:
Dim src As CodeModule, dest As CodeModule
Set src = ThisWorkbook.VBProject.VBComponents("Sheet1").CodeModule
Set dest = Workbooks("Book3").VBProject.VBComponents("ThisWorkbook") _
.CodeModule
dest.DeleteLines 1, dest.CountOfLines
dest.AddFromString src.Lines(1, src.CountOfLines)
Credit: Copy VBA code from a Sheet in one workbook to another?
I'm not the greatest with VBA and haven't touched it in years therefore I resort to tutorials so I hope somebody can help!
In the long run I'm trying to, in the following order:
Open an explorer window in one excel document via a button (Done!)
select an excel doc (Hopefully selected multiple docs in the long run)
pull info from a certain row/column of a sheet though to the original excel book
So far I've scoured/chopped and changed and found the following (Thanks JMax on this site)
Sub test()
Dim wb As Workbook, wb2 As Workbook
Dim ws As Worksheet
Dim vFile As Variant
'Set source workbook
Set wb = ActiveWorkbook
'Open the target workbook
vFile = Application.GetOpenFilename("Excel-files,*.xls", _
1, "Select One File To Open", , False)
'if the user didn't select a file, exit sub
If TypeName(vFile) = "Boolean" Then Exit Sub
Workbooks.Open vFile
'Set targetworkbook
Set wb2 = ActiveWorkbook
'For instance, copy data from a range in the first workbook to another range in the other workbook
wb2.Worksheets("Sheet1").Range("C3:D4").Value = wb.Worksheets("Sheet3").Range("A1:B2").Value
End Sub
To me this looks in order however when It opens the excel doc it comes back with the 'subscript out of range' message.
What Im I missing? The cells and naming seem correct to me :(.
Thanks,
Dave
The error is being thrown because a Worksheet name doesn't exist in on of the Worksheet Collections.
wb2.Worksheets("Sheet1")
Worksheets("Sheet3")
I am trying to create a renamed copy of all active workbooks (even non macro-enabled ones) without formulas, possibly by pasting values but without modifying images. I am working with Excel 2007.
My process would ideally be to:
1) Create a do while there are xls files loop that converts all xls files to xlsm. One possible addition would be an array to store A)the worksheet name(s) B)Its tabs name and their status
2) Run a for each or for loop that automatically pastes values for all active worksheets include those with graphs or other images into a new document that has the same name with all small addition at the end.
3) Convert my newly-named files containing values only into xls.
One issue I am running into when I try to do this has to do with links. The initial worksheets have formulas with links that do not automatically update. When I do this, the formulas in the original worksheet with link references tend to get corrupted.
Here is a general macro I found for pasting values:
Sub test()
Dim MyNames As Range, MyNewSheet As Range
Set MyNames = Range("R5").CurrentRegion ' load contigeous range into variable
For Each MyNewSheet In MyNames.Cells ' loop through cell children of range variable
Sheets.Add.Name = MyNewSheet.Value
Next MyNewSheet
MyNames.Worksheet.Select ' move selection to original sheet
End Sub
I think this is what you're asking for:
Sub test()
Dim wb As Workbook
Dim ws As Worksheet
Dim counter As Integer
Dim filePath As String
Set wb = ActiveWorkbook
countet = 1
filePath = "c:/" 'Enter your destination folder here
For Each ws In wb.Sheets
Sheets("Sheet1").Copy
With ActiveSheet.UsedRange
.Value = .Value
End With
ActiveWorkbook.SaveAs filePath & counter & ".xlsx", FileFormat:=51
counter = counter + 1
Next ws
End Sub
This is mostly taken from here.
The counter is a bit of a hack to make sure that the files aren't all being saved as the same name and overwriting each other. Maybe there's a more appropriate way that you can get around this.
I have an existing workbook that will be used by multiple users (who will name the workbook uniquely - I can set one Workbook Codename if needed though, though don't know how to do this?).
I need to create a macro that opens a new workbook (which presumably I won't know the name of? as it could be 'Book1', 'Book2', 'Book3' etc?), then returns to the original workbook where the macro is stored, and copies several (can do one at a time if needed) sheets (that I DO know the names of these sheets) and pastes them as new sheets into the new workbook that I created at the start. The macro does not need to Save the file (in fact it's preferable that it doesn't as I want the user to save the new workbook wherever is most convenient for the user).
I have attempted to show what the macro would do, showing the obvious problem that I do not know the names of the workbooks I am creating/copying from/pasting into.
Any help, much appreciated!
Sub CopySheetintoNewWorkbook()
'Macro opens new / blank workbook (name unknown?)'
Workbooks.Add
'Macro goes back to original workbook where macro is saved (of which the name is unknown to the macro - i.e., users can and will change it)'
Windows("UnknownWorkbookName-1").Activate
'Macro goes to a sheet which can be named and will be known, so this is no problem'
Sheets("KnownSheet").Select
'Macro creates a copy of the sheet and pastes it as a new sheet within the new, unknown named workbook'
Application.CutCopyMode = False
Sheets("KnownSheet").Copy Before:=Workbooks("UnknownWorkbookName-2").Sheets(1)
End Sub
We want to copy Sheet1 and Sheet2.
This relies on a tiny trick:
Sub qwerty()
Dim wb1 As Workbook, wbNEW As Workbook
Set wb1 = ActiveWorkbook
Sheets("Sheet1").Copy
Set wbNEW = ActiveWorkbook
wb1.Sheets("Sheet2").Copy after:=wbNEW.Sheets(1)
End Sub
When the first .Copy is performed, a new workbook is created and it becomes the ActiveWorkbook ........the rest is easy.
EDIT#1:
If we have a group of sheets to be copied, then we can create an array of sheet names and loop through the array, copying one sheet at a time:
Sub qwerty()
Dim wb1 As Workbook, wbNEW As Workbook
Dim ary() As String, s As String, i As Long
s = "Larry,Moe,Curly"
ary = Split(s, ",")
Set wb1 = ActiveWorkbook
i = 1
For Each a In ary
If i = 1 Then
Sheets(a).Copy
Set wbNEW = ActiveWorkbook
Else
wb1.Sheets(a).Copy after:=wbNEW.Sheets(1)
End If
i = 2
Next a
wbNEW.Activate
End Sub