I'm looking to copy a worksheet from a closed workbook in another location. The worksheet would be dependent on a cell reference. For example if I had the name 'Employee list 'in cell A1 then the code would search for that worksheet and copy it. If that cell was to change to 'new employee list' then the code would search and copy the worksheet with that name. I have tried using the code below without success, any help would be appreciated, thanks
Sub CopySheet()
Dim strSheetName As String
strSheetName = ActiveSheet.Range("A1")
Application.ScreenUpdating = False
With Workbooks.Open("C:\path")
DoEvents '//// ensure workbook is open
.Worksheets(strSheetName).Copy Before:=ThisWorkbook.Sheets(1)
.Close False
End With
Application.ScreenUpdating = True
End Sub
Related
Her also a newbie on VBA.
I have looked at a lot of topics and I could actually find some parts of the solution I’m looking for.
But I can’t see how to combine them in to one VBA.
I have an Excel Workbook that contains information and formula’s on a specific sheet.
I would like to copy that entire sheet to an new ONE sheet Workbook and save it.
The criteria for this new sheet are also:
- Keep the formatting as is.
- Remove all formulas (only remain values)
- Clear data in certain ranges or specific cells
- The destination sheet doesn’t need to contain macro’s (XLSX file type)
I would like to start this action from the source Sheet by using a shape and assign this to the VBA.
Here is what I found:
Copy sheet to new workbook:
Sheets("Sheet1").Copy Before:=Workbooks("Example.xlsx").Sheets(1)
Copy keep format but remove formulas
ActiveSheet.Copy
Cells.Copy
Range("A1").PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Clear cells / ranges:
Sub Clearcells()
Range("A2", "A5").Clear
Range("C10", "D18").Clear
Range("B8", "B12").Clear
End Sub
(Is it possible also to have the option to add a complete column? Like:
Range("B:B").Clear
Is there someone who can help me out in combining this into one running VBA?
Thanks, upfront.
Alex
Something like this?
Public Sub Test()
Dim wrkbk As Workbook
Dim rng As Range
'Create new workbook with single sheet.
Set wrkbk = Workbooks.Add(xlWBATWorksheet)
'Copy sheet to new workbook and remove the existing sheet
'without displaying any confirmation messages.
ThisWorkbook.Worksheets("Sheet1").Copy Before:=wrkbk.Sheets(1)
Application.DisplayAlerts = False
wrkbk.Sheets(2).Delete
Application.DisplayAlerts = True
'Remove formula, clear contents of cells.
'ClearContents - remove formula and values from cells.
With wrkbk.Worksheets(1)
With .UsedRange
.Cells.Copy
.Cells.PasteSpecial Paste:=xlPasteValues
End With
.Range("A2:A5,C10,D18,B:B").ClearContents
End With
End Sub
Updated code to copy more than one sheet
Public Sub Test()
Dim wrkbk As Workbook
Dim wrkSht As Worksheet
Dim rng As Range
'Create new workbook with single sheet.
Set wrkbk = Workbooks.Add(xlWBATWorksheet)
With wrkbk
'Rename the only sheet so it doesn't clash with those being copied across.
'Only need to do that if you're going to have a sheet called Sheet1.
.Worksheets(1).Name = "DELETE ME"
'Copy the sheets across and then delete the last one.
'Can either delete by name, or use position of sheet.
'Worksheet = normal sheet.
'Sheets = any sheet (chart sheet, worksheet, old style macro sheet).
ThisWorkbook.Worksheets(Array("Sheet1", "Sheet2")).Copy Before:=.Sheets(1)
Application.DisplayAlerts = False
.Worksheets("DELETE ME").Delete
'--OR--
'.Sheets(.Sheets.Count).Delete
Application.DisplayAlerts = True
End With
'Remove formula, clear contents of cells.
'ClearContents - remove formula and values from cells.
'UsedRange isn't the best way to find the last cell, but is ok for this.
For Each wrkSht In wrkbk.Worksheets
With wrkSht
With .UsedRange
.Cells.Copy
.Cells.PasteSpecial Paste:=xlPasteValues
End With
.Range("A2:A5,C10,D18,B:B").ClearContents
End With
Next wrkSht
End Sub
Further reading: With, ThisWorkbook
Thanks for all your support and help.
It is working now :-)
I needed to put also some more in the last part of the code:
Like: With wrkbk and End With
But I looked at your part of the code and tried it, and not it is working.
If it is a proper coding format, I don't know but it is working.
Thanks again.
Full code is now:
Public Sub Test()
Dim wrkbk As Workbook
Dim wrkSht As Worksheet
Dim rng As Range
'Create new workbook with single sheet.
Set wrkbk = Workbooks.Add(xlWBATWorksheet)
With wrkbk
'Rename the only sheet so it doesn't clash with those being copied across.
'Only need to do that if you're going to have a sheet called Sheet1.
.Worksheets(1).Name = "DELETE ME"
'Copy the sheets across and then delete the last one.
'Can either delete by name, or use position of sheet.
'Worksheet = normal sheet.
'Sheets = any sheet (chart sheet, worksheet, old style macro sheet).
ThisWorkbook.Worksheets(Array("Sheet1", "Sheet2")).Copy Before:=.Sheets(1)
Application.DisplayAlerts = False
.Worksheets("DELETE ME").Delete
'--OR--
'.Sheets(.Sheets.Count).Delete
Application.DisplayAlerts = True
End With
'Remove formula, clear contents of cells.
'ClearContents - remove formula and values from cells.
'UsedRange isn't the best way to find the last cell, but is ok for this.
For Each wrkSht In wrkbk.Worksheets
With wrkSht
With .UsedRange
.Cells.Copy
.Cells.PasteSpecial Paste:=xlPasteValues
End With
'.Range("A2:A5,C10,D18,B:B").ClearContents
End With
Next wrkSht
With wrkbk
.Worksheets("Sheet1").Range(""A2:A5,C10,D18,B:B"").ClearContents
.Worksheets("Sheet2").Range("X8:Y12,F10,G18,L:L").ClearContents
End With
End Sub
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 am using an excel Workbook for programtical generation. Once the workbook is created few of the sheets are having required data and few are blank with default templates only.
I need to delete all sheets having default templates (means no data). I can check specific cell to identify this however need to know how to check for all sheets and then delete sheets one by one.
I am having this piece of code:
Sub TestCellA1()
'Test if the value is cell D22 is blank/empty
If IsEmpty(Range("D22").Value) = True Then
MsgBox "Cell A1 is empty"
End If
End Sub
Try this:
Sub DeleteEmptySheets()
Dim i As Long, ws As Worksheet
' we don't want alerts about confirmation of deleting of worksheet
Application.DisplayAlerts = False
For i = Worksheets.Count To 1 Step -1
Set ws = Worksheets(i)
' check if cell D22 is empty
If IsEmpty(ws.Range("D22")) Then
Sheets(i).Delete
End If
Next
' turn alerts back on
Application.DisplayAlerts = True
End Sub
An alternative implementation using For-Each:
Sub deleteSheets()
Dim wb As Workbook
Dim sht As Worksheet
Set wb = Workbooks("Name of your Workbook")
'Set wb = ThisWorkbook You can use this if the code is in the workbook you want to work with
Application.DisplayAlerts = False 'skip the warning message, the sheets will be deleted without confirmation by the user.
For Each sht In wb.Worksheets
If IsEmpty(sht.Range("D22")) And wb.Worksheets.Count > 1 then
sht.Delete
End If
Next sht
Application.DisplayAlerts = True
End Sub
This mainly serves as a demonstration pf how you can easily loop through worksheets.
As suggested in the comments below by #Darren Bartrup-Cook , the logic according to which the sheets are deleted can and should be modified to not only suit your purposes but to also include safeguards.
Making sure there's always at least one worksheet in the workbook is one of them. This can be ensured in a multitude of ways. I updated my answer to implement one these.
I have written VBA code that opens up a destination workbook, copies one of the worksheets, and pastes it into the current workbook.
When I run it a second or third time etc... instead of overwriting the current worksheet, it creates a completely new one.
Ex: Worksheet is called "data", first time it transfers "data", second time "data(2)".
I have another worksheet that uses VLOOKUP function to look at some cells of this data worksheet, so it is crucial that it has correct name "data".
I thought about deleting the current (data) file before running the macro, but what if something crashes and I lose my worksheet? Is there a better solution?
NOTE: I am running the macro from the main workbook to get the sheet to be copied from the external workbook.
Sub UpdateT()
Dim wb As Workbook
Dim aw As Workbook
'Open 2nd Workbook
Set aw = Application.ActiveWorkbook
Set wb = Workbooks.Open(Filename:="C:\Users\yilmadu00\Desktop\T.xlsx")
'Copy To Different Workbook
wb.Sheets("data").Copy After:=aw.Sheets("Data1")
'Close 2nd Workbook
aw.Save
wb.Close
aw.Sheets("data").Visible = False
ActiveWorkbook.Protect ("Password")
End Sub
Function to check whether worksheet exists (credits to #ScottCrainer):
Function SheetExists(ws As String)
SheetExists = Not IsError(Application.Evaluate(ws & "!A1"))
End Function
NOTE:
It does have the issue: if A1 on the sheet contains an error it will return a false negative.
ActiveWorkbook vs ThisWorkbook, Sheets vs Worksheets
You have used 'Activeworkbook' and 'Sheet(s)' in the code so I played along.
But
Although you can have a third workbook to run the code from, I'm guessing you are running the code from a module in the 'ActiveWorkbook'. If this is true, it would be more correct to use 'ThisWorkbook' instead which always refers to the workbook that contains the code (module), to avoid accidentally running the code on a third workbook.
Sheet(s) refers to Worksheet(s) and Chartsheet(s), again I'm guessing there are no chartsheets involved in this code, therefore it would be more correct to use 'Worksheet(s)' instead of 'Sheet(s)'.
Sub UpdateT()
Const cStrPath As String = "C:\Users\yilmadu00\Desktop\T.xlsx"
Const cStrAfter As String = "Data1"
Const cStrName As String = "data"
Const cStrOld As String = "data_old"
Dim aw As Workbook '1st workbook, 'ActiveWorkbook'
Dim wb As Workbook '2nd workbook
Dim oWs As Sheet 'Each sheet in workbook 'aw'
Dim blnFound As Boolean 'True if sheet(cStrName) was found
Set aw = ActiveWorkbook 'Create a reference to the ActiveWorkbook
Set wb = Workbooks.Open(Filename:=cStrPath) 'Open 2nd Workbook
With aw
' .UnProtect ("Password")
'Check each sheet in workbook 'aw'.
For Each oWs In aw.Sheets
With oWs
'Check if there already is a sheet with the name 'cStrName'.
If .Name = cStrName Then
.Name = cStrOld 'Rename the sheet.
blnFound = True 'Sheet(cStrName) was found.
Exit For 'Immediately stop checking, there can only be one.
End If
End With
Next
End With
With wb
'Copy sheet from 2nd workbook ('wb') to workbook 'wa'.
.Sheets(cStrName).Copy After:=aw.Sheets(cStrAfter)
.Close 'Close 2nd workbook ('wb').
End With
With aw
With Application
If blnFound = True Then 'Sheet(cStrName) was found.
.DisplayAlerts = False 'Disable showing delete message.
aw.Sheets(cStrOld).Delete 'Delete old version of sheet.
.DisplayAlerts = True
End If
End With
.Sheets(cStrName).Visible = False 'Hide sheet named 'cStrName'
.Protect ("Password")
.Save 'Save workbook 'aw'.
End With
End Sub
The next time you want to do something with the sheet you have to unprotect it or the code will fail. Hidden sheets can be deleted with no problems.
I have a simple macro that opens a csv file and supposed to copy a cell in the working Workbook:
Sub macro1()
Dim build_w As Workbook
Dim build_s As Worksheet
Dim folder_st As String
Application.ScreenUpdating = False
folder_st = "c:\file.csv"
Set build_w = Application.Workbooks.Open(folder_st)
Set build_s = build_w.Sheets("build")
build_s.Range("A1").Copy
ActiveSheet.Paste Range("A284")
build_w.Close True
Application.ScreenUpdating = True
End Sub
If I comment out the line build_s.Range("A1").Copy everything is fine, but If I leave this in, Excel crashes every single time.
Any suggestions?
Are you aware that the ActiveSheet at the moment you paste is itself the build_s worksheet? This is the problem when working with stuff like Activesheet. It is always preferable to specify worksheet and workbook objects precisely, without counting on what is active at a given moment.
Eventually, to get the behavior you want, you should do:
build_s.Range("A1").Copy ThisWorkbook.ActiveSheet.Range("A284")
Have you tried handling any possible errors with:
On Error GoTo MyHandler
MyHandler:
PFB for the require code. CSV file cannot have multiple sheets so that's why it must be crashing. CSV files can have only one sheet in it, so no need to specify sheet name.
Sub macro1()
'Declared variables
Dim build_w As Workbook
Dim folder_st As String
'Disabling screen updates
Application.ScreenUpdating = False
'Initializing the file name
folder_st = "c:\file.csv"
'Opening the workbook
Set build_w = Workbooks.Open(folder_st)
'Copying the value of cell A1
Range("A1").Copy
'Selecting the cell A284
Range("A284").Select
'Pasting the copied value
ActiveSheet.Paste
'Saving the workbook by saving the .CSV file
build_w.Close True
'Enabling screen updates
Application.ScreenUpdating = True
End Sub
it's because upon opening csv file it becomes the Active workbook and its only worksheet the Active worksheet
you can exploit this at your advantage like follows:
Option Explicit
Sub macro1()
Dim folder_st As String
Application.ScreenUpdating = False
folder_st = "c:\file.csv"
With ActiveSheet '<--| reference your currently active sheet before opening csv file
Application.Workbooks.Open(folder_st).Sheets("build").Range("A1").Copy '<--| open csv file (and it becomes the Active Workbook) and reference its "build" sheet range "A1" and copy it...
.Range("A284").PasteSpecial '<--| paste it to your referenced sheet range A284
Application.CutCopyMode = False '<--| release clipboard
ActiveWorkbook.Close False '<--| close Active workbook, i.e. the csv file
End With
Application.ScreenUpdating = True
End Sub