I have a workbook with 2 sheets, I am only concerned with Sheet1 for this function.
I copy the data from columns A and G into a new workbook using the following code I found on this site.
Sub dural()
Dim r1 As Range, r2 As Range
Sheets(1).Select
Set r1 = Range("A:A")
Set r2 = Range("G:G")
Set wbNew = Workbooks.Add
r2.Copy Range("A1")
r1.Copy Range("B1")
End Sub
I don't need the new workbook to open and be displayed like the above code does.
I would like to automatically create and save the output as a new file, preferably in a specific directory. Lets call it output.xlsx. The original file is SOURCE.xlsm
Something simple like this:
Sub dural()
With Workbooks.Add
ThisWorkbook.Sheets(1).Range("G:G").Copy .Sheets(1).Range("A1")
ThisWorkbook.Sheets(1).Range("A:A").Copy .Sheets(1).Range("B1")
.SaveAs "your path + filename here"
.Close
End With
End Sub
should do all you want.
If you still have any questions, just ask :)
Related
So I am trying to write a Macro for Excel, that adds 2 worksheets from an excel file to a new one.
Therefore, I try this:
Sub addfile()
Dim sheet1 As Worksheet
Dim sheet2 As Worksheet
Set sheet1 = Sheets.Add(Type:="C:\Users\Helge\AppData\Roaming\Microsoft\Templates\page1.xltx")
Set sheet2 = Sheets.Add(Type:="C:\Users\Helge\AppData\Roaming\Microsoft\Templates\page2.xltx")
End Sub
When I test it, it imports the first page, but the 2nd page gives me a Runtime error 1004.
Why does this happen?
And is there another way to get 2 sheets from one excel file to another via vba?
Much to my surprise this version of your code actually worked for me.
Sub addfile()
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Set Sheet1 = Sheets.Add(Type:=Environ("Userprofile") & "\OneDrive\Desktop\Template1.xltx")
Set Sheet2 = Sheets.Add(Type:=Environ("Userprofile") & "\OneDrive\Desktop\Book2.xlsx")
Debug.Print Sheet1.Name, Sheet2.Name
End Sub
The reason for my surprise is that Sheet1 and Sheet2 are the default CodeName for the first and second worksheets in any workbook. Therefore there is a conflict of naming between the Sheet1 in the workbook and the Sheet1 you declare which should come to the surface not later than Debug.Print Sheet1.Name. In fact, it may have. I didn't check which name was printed. But the code didn't crash. Since it crashes on your computer, perhaps you have an older version of Excel. Try to stay clear of variable names that Excel also uses. Or there is something wrong with the path & file name, which is hard to tell in that syntax and therefore kept me fooled for quite some time too.
In fact, I discovered the above only after finding out that my Desktop was on OneDrive and not before I had written the function below which is designed to avoid the use of Sheets.Add. It also has some extras such as being able to specify the sheet to take from the template (you could have one template with 2 or more sheets). You can specify an index number or a sheet name. And the function will give a name to the copy, too, if you specify one.
Private Function AddWorksheet(ByVal Template As String, _
TabId As Variant, _
Optional ByVal TabName As String) As Worksheet
Dim Wb As Workbook
Dim Path As String
Dim FileName As String
Set Wb = ThisWorkbook ' change to suit
' make sure the path ends on "\"
Path = "C:\Users\Helge\AppData\Roaming\Microsoft\Templates\"
With Workbooks.Open(Path & Template)
.Sheets(TabId).Copy After:=Wb.Sheets(Wb.Sheets.Count)
.Close
End With
Set AddWorksheet = ActiveSheet
If Len(TabName) Then ActiveSheet.Name = TabName
End Function
You can call the function from a sub routine like this:-
Sub AddWorksheets()
Dim Tab1 As Worksheet
Dim Tab2 As Worksheet
Application.ScreenUpdating = False
Set Tab1 = AddWorksheet("Page1.xltx", 1, "New Tab")
Set Tab2 = AddWorksheet("Page2.xltx", "Sheet1", "Another new Tab")
Application.ScreenUpdating = True
End Sub
Please observe the difference between the two function calls.
I'm using a macro to make a copy of the active sheet, and rename it to whatever the value of cell 'C2' is. The only problem is, that when it copies the sheet, it somehow removes the form buttons from the top of my worksheet and replaces them with the code =$c$2 in cell 'AF'.
As far as i can see from the VBA code there is nothing that refers to the cell 'AF'. Can anyone tell me why it's doing this ?
Sub Copy_Rename()
Dim shtName As String
shtName = ActiveSheet.Name
ActiveSheet.Copy before:=ActiveSheet
ActiveSheet.Name = Range("C2").Value
Sheets(shtName).Activate
End Sub
Try this:
Sub Copy_Rename()
Dim sht As Worksheet
Set sht = ActiveSheet
Application.CopyObjectsWithCells = True '<< to also copy objects not just cell contents etc
sht.Copy before:=sht
'Get the just-created sheet
With Sheets(sht.Index - 1)
.Name = sht.Range("C2").Value
.Activate
End With
End Sub
I have a excel workbook A.xlsx with columns A through T, now i need to copy specific columns H,K,L to a new workbook which would be created while i run a macro.
I was able to successfully copy a range of columns from one worksheet to another, but i am not finding a way to copy specific columns to a new workbook.
Private Sub copy_sub()
Sheets("Sheet1").Columns("H:K").Copy Sheets("Sheet2").Range("A1")
End Sub
Give this a try:
Sub dural()
Dim r1 As Range, r2 As Range
Sheets("Sheet1").Select
Set r1 = Range("K:L")
Set r2 = Range("H:H")
Set wbNew = Workbooks.Add
r2.Copy Range("H1")
r1.Copy Range("K1")
End Sub
Based on the fact that after the workbook is added, the new workbook will be active and Sheet1 will be the active sheet in that book. Also assumes that cols H,K,L are to be copied, but not col I.
Try below sample code
Private Sub copy_sub()
Dim wkb As Workbook
Set wkb = Workbooks.Add ' Will add new workbook
' with column name
ThisWorkbook.Sheets("Sheet1").Columns("H").Copy wkb.Sheets("Sheet2").Range("A1")
'with column index
ThisWorkbook.Sheets("Sheet1").Columns(9).Copy wkb.Sheets("Sheet2").Range("A1")
End Sub
I have the following code adding sheets from one workbook to another. However, I only want to add the values and not the formulae. How do I achieve this?
Sub publish()
Dim new_wb As Workbook
Dim old_wb As Workbook
Dim i As Long
Dim new_file_path As String
Call refresh_output_sheets
new_file_path = Range("output_path").Value
Set old_wb = ActiveWorkbook
Set new_wb = Workbooks.Add
For Each sh In old_wb.Sheets
If InStr(LCase(sh.CodeName), "output") <> 0 Then
sh.Copy After:=new_wb.Sheets(new_wb.Sheets.Count)
End If
Next sh
Not thoroughly tested but hopefully this will get you close. Replace your copy loop with something like this:
For Each sh In old_wb.Sheets
If InStr(LCase(sh.CodeName), "output") <> 0 Then
sh.Copy
new_wb.Sheets(new_wb.Sheets.Count).PasteSpecial Paste:=xlPasteValues
End If
Next sh
If it's giving you fits, let me know and I'll do some more testing.
Once you have copied a worksheet to the new workbook, activate it and run this:
Sub ClearFormulas()
On Error Resume Next
ActiveSheet.Cells.SpecialCells(xlCellTypeFormulas).ClearContents
End Sub
So basically, remove the formulas after the copy has been made.
Use this:
...
sh.Copy After:=new_wb.Sheets(new_wb.Sheets.Count)
new_wb.Sheets(new_wb.Sheets.Count).Cells.Values=sh.Cells.Values
End If
...
As you know, first statement will copy all data.
Then, new worksheet values are assigned from source, removing all formulas.
I find useful make .Copy before using .Value to copy formats, column widths, ...
I have a workbook containing one worksheet ("DB Output" or Sheet 34) which I would like to copy to several (around 45) files in within the same folder.
None of the target files have an existing sheet named "DB Output" - the objective is to find a way to insert a copy of this sheet, forumlas and all, into each one.
The range of cells on that sheet that needs to be copied to a sheet of the same name in each book is A1:PE5
The sheet contains references to cells in the book it is currently in, however as the files which I am seeking to copy the worksheet to all share the same template, I want the references to be to the local file, not the original one.
I've tried looking at RDBMerge, however it seems that is for merging sheets, and while I do want to do that, it will not help me do it multiple times quickly.
Likewise I have looked on SO for similar situations, this is the closest, however my attempts to adapt that code have failed as I only have a single workskeet. Never the less, as it is always useful to inlcude what you have already tried, here is my existing attempt:
Option Explicit
Public Sub splitsheets()
Dim srcwb As Workbook, trgwb As Workbook
Dim ws As Worksheet, t1ws As Worksheet
Dim rng1 As Range
Dim trgnm As String
Dim fpath As String
Application.ScreenUpdating = False
'--> Set this to the location of the target workbooks
fpath = "C:/file/path/"
Set srcwb = ThisWorkbook
For Each ws In srcwb.Worksheets
trgnm = ws.Name
'--> Change A1:B3 to the range to be copied to inside page
Set rng1 = srcwb.Sheets(trgnm).Range("A1:PE5")
Set trgwb = Workbooks.Open(fpath & trgnm & ".xlsm")
With trgwb
Set t1ws = .Sheets("DB Output")
End With
'--> Change A1:B3 to the range where you want to paste
rng1.Copy t1ws.Range("A1:PE5")
trgwb.Close True
Next
Application.ScreenUpdating = True
End Sub
However this starts with the first sheet in the workbook that contains DB Output (the sheet to be copied) and gives an error that "NameOfSheet1.xlsm" does not exist in that directory (which it does not).
Any help is much appreciated.
This should copy from the active workbook to all files in a directory. If you need help modifying it to fit your specific use let me know!
Edit: fixed code to only copy A1:PE5 and save each workbook.
Sub Example()
Dim path As String
Dim file As String
Dim wkbk As Workbook
path = "C:\Test\"
file = Dir(path)
Application.DisplayAlerts = False
Do While Not file = ""
Workbooks.Open (path & file)
Set wkbk = ActiveWorkbook
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "DB Output"
ThisWorkbook.Sheets("DB Output").Range("A1:PE5").Copy Destination:=wkbk.Sheets("DB Output").Range("A1")
wkbk.Save
wkbk.Close
file = Dir
Loop
Application.DisplayAlerts = True
End Sub
Please note that I did not add error handling so this could break if the active workbook is included in the directory you are trying to copy or if a sheet with the same name already exists in the workbook. If this is an issue let me know and I will add error handling.