right now I am trying to create an excel macro which should copy one worksheet from my workbook. This worksheet should be saved as a new Excel file named with the value from cell B1.
Everything works fine so far.
The problem is: I want that the copy is a back-up. So the values in the table (copy) should not be connected to the original table.
So to make it short: I just want to copy format+values but not the formulas from the table.
Do you have any ideas how I can make this work?
Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Dim FName As String
Dim FPath As String
Dim wbkExport As Workbook
Dim shtToExport As Worksheet
FPath = "C:\Users\User\Desktop\Artikelnummern"
FName = Worksheets("Test").Cells(1, 2).Value
Set shtToExport = ThisWorkbook.Worksheets("Test")
Set wbkExport = Application.Workbooks.Add
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
Application.DisplayAlerts = False 'Possibly overwrite
without asking
wbkExport.SaveAs Filename:=FPath & "\" & FName & ".xlsx"
Application.DisplayAlerts = True
wbkExport.Close SaveChanges:=False
End Sub
Replace your line:
shtToExport.Copy Before:=wbkExport.Worksheets(wbkExport.Worksheets.Count)
With:
shtToExport.Cells.Copy
wbkExport.Worksheets(wbkExport.Worksheets.Count - 1).Range("A1").PasteSpecial xlPasteValues
wbkExport.Worksheets(wbkExport.Worksheets.Count - 1).Range("A1").PasteSpecial xlPasteFormats
Related
As pre-warning, I am new to using VBA.
I have scraped together the following code to do the following:
1. Locate the worksheet "Intrastat"
2. Copy the used range of this worksheet
3. Paste as values into a new workbook
4. Reformat dates in column B
5. Save the workbook with in the original workbook's location.
However this only works when I have the macro saved in the original workbook. What I need is to be able to have the macro saved in a different workbook and on running the macro I need to be able to select the "original" workbook from a file location on my HDD.
Any ideas?
The Current Code:
Sub TB_Intrastat_Data_Cleanse()
Dim wb As Workbook
Set wb = Workbooks.Add
Set TWKB = ThisWorkbook
Set sel = Selection
Dim folderPath As String
folderPath = Application.ThisWorkbook.Path
TWKB.Sheets("Intrastat").UsedRange.Copy
wb.Sheets(1).[a1].PasteSpecial xlPasteValues
Columns("B:B").Select
Selection.NumberFormat = "dd/mm/yyyy;#"
nme = "TB Intrastat Data " & Range("A3") & " MTD"
ActiveWorkbook.SaveAs Filename:=folderPath & nme
End Sub
You can use Application.GetOpenFilename() to prompt the user to browse through the file explorer, and open a file. It will then use that file as TWKB:
Sub TB_Intrastat_Data_Cleanse()
Dim wb As Workbook, TWKB As Workbook
Dim sel As Range
Dim nme As String
Set wb = Workbooks.Add
Set TWKB = Application.GetOpenFilename(Title:="Please choose a file to open", FileFilter:="Excel Files *.xls* (*.xls*),")
Set sel = Selection
Dim folderPath As String
folderPath = Application.ThisWorkbook.Path
TWKB.Sheets("Intrastat").UsedRange.Copy
wb.Sheets(1).[a1].PasteSpecial xlPasteValues
Columns("B:B").NumberFormat = "dd/mm/yyyy;#"
nme = "TB Intrastat Data " & Range("A3") & " MTD"
ActiveWorkbook.SaveAs Filename:=folderPath & nme
End Sub
Note: I would change ActiveWorkbook.SaveAs at the end to a workbook variable (or explicitly name the workbook), since you're using two separate ones you want to make sure it's saving the correct one.
I have a workbook that generates pages/page names. The worksheet name always reflects a job number. The job number is also always displayed in cell A1.
I want to copy data from another book, and paste it back into this worksheet, but I need to target the page I want to paste the data.
My issue is that I can't say wbkDest.Worksheets("sheet1").
I need to say something like wbk.Dest.Worksheets(Range("a1").value).
So again: Paste in the sheet with the same name as cell A1 in the workbook the macro is triggered from.
sub import()
Dim wbkSrc As Workbook, wbkDest As Workbook
Dim myFile As String
Dim Path As String
Dim emptyRow As Long
Dim wsOrig As Worksheet
Set wsOrig = ThisWorkbook.Worksheets(1)
emptyRow = 1
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set wbkDest = Workbooks("lathe_project6-1-2017.xlsm")
Path = "G:\FIXTURES\" & Range("A1").Value & "\lists\new folder\"
myFile = Dir(Path & "*.xls??")
Set wbkSrc = Workbooks.Open(Path & myFile)
wbkSrc.Worksheets(1).Range("A1:I100").Copy
wbkDest.Worksheets(wsOrig.Range("A1").Value).Cells(emptyRow, 1).PasteSpecial Paste:=xlPasteValues
wbkSrc.Close
End Sub
This doesn't work:?
Dim wskVariableSheet as worksheet
Set wskVariableSheet = wbkDest.Sheets(Range("a1").Value)
And then just reference to wskVariableSheet.range where you want to paste.
i have a workbook that i use as a template to make estimates that when i'm done filling out the template there is a macro that creates a new workbook and copies all the sheets of the template workbook to the new one and then removes all the formulas and info i don't want the customer to see.
Here's part of my code that creates the new workbook and copies all the sheets from the template to the new one and then cleans it up
Sub TestConvert()
'Disabling the following to speed up the vba code, must re-enable at end of code
ActiveSheet.DisplayPageBreaks = False
Application.EnableEvents = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.DisplayAlerts = False
'adds file name and path to all sheets
Dim WSfn As Worksheet
For Each WSfn In ThisWorkbook.Sheets
'Adds formula to show file path
WSfn.Range("A2") = "=LEFT(CELL(""filename"",RC),FIND(""["",CELL(""filename"",RC),1)-1)"
'Adds formula to show file name
WSfn.Range("A3") = "=MID(CELL(""filename""),FIND(""["",CELL(""filename""))+1,(FIND(""]"",CELL(""filename""))-FIND(""["",CELL(""Filename""))-16))"
WSfn.Calculate 'Calculate sheet
WSfn.Range("A2") = WSfn.Range("A2") 'this will remove the formula from the cell making it text only
WSfn.Range("A3") = WSfn.Range("A3") 'this will remove the formula from the cell making it text only
Next
'************************************************************************************************
'copies all the sheets of the open workbook to a new one
Dim thisWb As Workbook, wbTemp As Workbook
Dim ws As Worksheet
Set thisWb = ThisWorkbook
Set wbTemp = Workbooks.Add 'creates new workbook dimmed as WbTemp
On Error Resume Next 'if there is in error when deleting will not stop the macro from continuing...
'.. deletes the extra sheets 2 sheets if on an older versions of excel
For Each ws In wbTemp.Worksheets
ws.Delete 'deletes all but one sheet in new workbook
Next
On Error GoTo -1 'clears the error handling and sets it to nothing which allows you to create another error trap.
'copys all the sheets from the original to the new workbook dimmed as wbTemp
For Each ws In thisWb.Sheets
ws.Copy After:=wbTemp.Sheets(wbTemp.Worksheets.Count)
Next
wbTemp.Sheets(1).Delete 'deletes the the first sheet in the list in the new workbook which is a black sheet from creating a new workbook
'put vba code to be ran in new book here
'makes all formulas in new workbook values only
wbTemp.Sheets.Select 'selects all sheets in new workbook
Cells.Select 'selects all cell
Selection.Copy 'copies everything selected
Selection.PasteSpecial Paste:=xlPasteValues 'pastes as values only in selected cells
wbTemp.Application.CutCopyMode = False 'clears the clipbored
'removes all defind names from new workbook / submittal
Dim xName As Name
For Each xName In wbTemp.Names
xName.Delete
Next
'removes all dropdowns from new workbook / submittal
Dim DD As Worksheet
For Each DD In wbTemp.Worksheets
Cells.Select
DD.Cells.Validation.Delete
Range("A1").Select
Next
'removes all vba buttons from all sheets
Dim i As Integer
On Error Resume Next
For i = 1 To 1000
wbTemp.Sheets(i).Buttons.Delete
Next i
'All sheets scroll to top left and select "A1"
Dim Sht As Worksheet
'****************************
'change A1 to suit your preference
Const TopLeft As String = "A1"
'****************************
'loop thru all the sheets in the workbook
For Each Sht In Worksheets
'scroll:=True takes cell to the top-left of window
Application.Goto Sheet.Range(TopLeft), scroll:=True
Next
'Hides the following from all sheets
wbTemp.Sheets.Select 'selects all sheets in new workbook
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHeadings = False
'selects the first sheet in the list
Sheets(1).Select
ActiveSheet.DisplayPageBreaks = True
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
'save vba code here
'works to only add the filename would like it to also open in file path from cell A2
Application.Dialogs(xlDialogSaveAs).Show Range("A3").Text & "- (Submittal) " & Format(Date, "mm-dd-yy") & "_" & Format(Time, "hhmm") & ".xlsx"
End Sub
im wanting to make it so when the save window opens it opens in the file path from cell A2 and populates the filename from cell A3
i can also send/post the full excel file if that helps any.
The Application.GetSaveAsFilename method is a good choice for this. Pass the return value to a variant type var so you can test for Cancel or Close.
Dim sFN As Variant
With Worksheets("Sheet6")
sFN = .Range("A1") & Chr(92) & .Range("A2") & Format(Date, "_mm-dd-yy") '<~~ no extension yet
End With
With Application
sFN = .GetSaveAsFilename(InitialFileName:=sFN, _
FileFilter:="Excel Workbook (*.xlsx), *.xlsx," & _
"Macro Workbook (*.xlsm), *.xlsm," & _
"Binary Workbook (*.xlsb), *.xlsb")
End With
Select Case sFN
Case False
'user clicked Cancel or Close (×)
Debug.Print sFN
Case Else
With ThisWorkbook
Select Case Right(sFN, 5)
Case ".xlsx"
.SaveAs Filename:=sFN, FileFormat:=xlOpenXMLWorkbook
Case ".xlsm"
.SaveAs Filename:=sFN, FileFormat:=xlOpenXMLWorkbookMacroEnabled
Case ".xlsb"
.SaveAs Filename:=sFN, FileFormat:=xlExcel12
Case Else
'there really shouldn't be a case else
End Select
End With
End Select
I've added a Select Case statement statement for a Workbook.SaveAs method to three msot common types of Excel workbooks.
You can use the .InitialFileName property of the dialog.
Dim ws As Excel.Worksheet
Set ws = ActiveWorkbook.Sheets("Sheet1")
Dim oFileDialog As FileDialog
Set oFileDialog = Application.FileDialog(msoFileDialogSaveAs)
With oFileDialog
.Title = "Save File"
.ButtonName = "Ok"
.InitialFileName = ws.Range("A2").Value & "\" & ws.Range("A3").Value
.Show
End With
If you need to get back the name that it was saved as you can use .SelectedItems after .Show
MsgBox (oFileDialog.SelectedItems(1))
NOTE:
You probably want to do a quick verification that the directory in A2 exists before doing this. If it does not exist it will throw this into some users folder.
EDIT I'm not sure why yours isn't saving, could be excel version or some other variable in your code.
Since you have the path and name, do you really need the saveas dialog? You could just do
Workbooks.Add
'Then your code in your template that is modifying the active workbook
'Then save it without the dialog
ActiveWorkbook.SaveAs ws.Range("A2").Value & "\" & ws.Range("A3").Value
'OR
ActiveWorkbook.SaveAs Filename:= ws.Range("A2").Value & "\" & ws.Range("A3").Value
I'm trying to copy a sheet in another workbook like this
WB.Sheets("WorkSheet").Copy ThisWorkbook.Sheets(Sheets(Sheets.Count).Select)
So, I want that the copied sheet is the last sheet in my workbook. When I put a 1 in the last bracket it uses always a new sheet, but I want that it copies the sheet always in the same sheet, so overwrites it.
The whole thing look like that:
strPath = ThisWorkbook.Path & "\Subfolder\"
strFile = "copyFile.xlsx"
Application.ScreenUpdating = False
Dim WB As Workbook
Dim Ret
Ret = IsWorkBookOpen(strPath & strFile)
If Ret = True Then
Else
Set WB = Workbooks.Open(strPath & strFile)
End If
WB.Sheets("WorkSheet").Copy ThisWorkbook.Sheets(Sheets(Sheets.Count).Select)
WB.Close False
Application.ScreenUpdating = True
You can use either
WB.Sheets("WorkSheet").Copy **after:=** ThisWorkbook.Sheets(Sheets(Sheets.Count).Select)
Or
WB.Sheets("WorkSheet").Copy ThisWorkbook.Sheets(Sheets(Sheets.Count **+1** ).Select)
I dont have plenty of experience in VBA excel so i could use some help.
I created an excel worksheet.
Now i want to create a macro which sends the data from my worksheet to other excel workbooks.
I want to use an if statement so if project name = "x" then the macro should send data to workbook "x" and rank the imported worksheets by date.
I found this on the web and had adjusted it a bit
Private Sub CommandButton21_Click()
Dim Data As Range
Dim myData As Workbook
Worksheets("blad1").Select
Set Data = Range("c2")
Set myData = Workbooks.Open("C:\test\locatie.xlsx")
Worksheets("blad1").Select
Worksheets("blad1").Range("a1").Select
RowCount = Worksheets("blad1").Range("A1").CurrentRegion.Rows.Count
With Worksheets("blad1").Range("A1")
.Offset(RowCount, 0) = Data
End With
End Sub
Simple example to copy a sheet into a new file:
IF projectname = "x" THEN 'you have to define projectname
OldName = ThisWorkbook.Name 'name of your open file
Workbook.Add 'Open new file
newName = ActiveWorkbook.Name 'name of the new file
Windows(OldName).Activate 'original file select
Sheets("Sheetname").Activate 'define Sheetname of your original file
ActiveSheet.Select
ActiveSheet.Copy after:=Workbooks(newName).Sheets(1)
Windows(newName).Activate
ActiveWorkbook.SaveAs Filename:=filename1, FileFormat:=51, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, CreateBackup:=False 'define filename1
Application.DisplayAlerts = True
End If