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
I need to copy an image from my invoice template worksheet to another worksheet with variable names. For example, the name of the sheet could be "03-000008" or "04-000005" or any other name. This problem would be easy to solve if the sheets had the same name, but since they are variable, I am struggling. Any help would be much appreciated! Thank you in advance!
Tim suggested that I add the code I am working with (thanks Tim!) Here is the code that almost works, but instead of pasting the image to my new, active invoice sheet, it pastes it right on the template itself.
Sub image()
With ActiveSheet
Set i = Sheets("Template")
Set e = ActiveSheet
i.Shapes.Range(Array("Picture 4")).Select
Selection.Copy
e.Range("b1:b4").Select
ActiveSheet.Paste
End With
End Sub
Try this:
Sub image()
Dim ws As Worksheet
ThisWorkbook.Worksheets("Template").Shapes("Picture 4").Copy
For Each ws In ThisWorkbook.Worksheets
If ws.Name Like "##-######" Then 'check matches pattern [2digits-6digits]
ws.Paste Destination:=ws.Range("B1")
MsgBox "Pasted to " & ws.Name
Exit For 'no need to check further
End If
Next ws
End Sub
If all you need to do is copy the image from Template to the activesheet then:
Sub CopyLogo()
ThisWorkbook.Worksheets("Template").Shapes("Picture 4").Copy
ActiveSheet.Paste Destination:=ActiveSheet.Range("B1")
End Sub
Trying to create a excel worksheet using data from a VBA form then adding it to end of workbook. Please help to activate the code
Private Sub Add_Tab_Click()
Dim txtNameSur As Worksheet
Set txtNameSur = Worksheets("Me.Textbox1")
ThisWorkbook.Sheets(1).Copy after:=Sheets(Sheets.Count)
Newname = Worksheets.Add.Name = Userform1.txtNameSur.Value
ActiveSheet.Name = Newname
End Sub
The goal in your question is a bit unclear, but I guess you meant to do something like below:
Private Sub Add_Tab_Click()
'copy first worksheet to the end of the workbook
ThisWorkbook.Worksheets(1).Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
'set the copied worksheet to a variable `NewWorksheet`
Dim NewWorksheet As Worksheet
Set NewWorksheet = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count) 'last one is the copied one
'give it a new name (use the text in Textbox1 as name)
NewWorksheet.Name = Me.Textbox1.Text
End Sub
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
Continuing the question:
TextBox object customisation - Compile error: Invalid or unqualified reference
I am going to copy this element - textbox into all worksheets throughout my document.
I would like to have it exactly in the same place in each worksheet.
For this purpose I used the code:
Sub Asbuildcopy()
Dim wsh As Worksheet
Dim ArraySheets As String
Dim x As Variant
For Each wsh In ActiveWorkbook.Worksheets
ActiveSheet.Shapes("Textbox 3").Copy
Application.Goto Sheets(ArraySheets).Range("Q6")
ActiveSheet.Paste
ArraySheets(x) = wsh.Name
x = x + 1
End Sub
According to the advice here:
https://www.ozgrid.com/forum/index.php?thread/73851-copy-shape-to-cell-on-another-worksheet/
https://i.stack.imgur.com/lOhJj.png
stating about copying an element into another sheet.
Apart from my code, one problem is the location of this element. I used target cell as Q6, but I would like to have it exactly in the same place as on the 1st (initial) sheet.
Thank you for your hint,
Try this. As per comment, can use the Top and Left properties of a shape to position it as per the first sheet.
Use more meaningful procedure and variable names for your actual code.
Sub x()
Dim ws As Worksheet, ws1 As Worksheet, s As Shape
Set ws1 = Worksheets("Sheet1") 'sheet containing original textbox
Set s = ws1.Shapes("TextBox 3") 'name of original textbox
Application.ScreenUpdating = False
For Each ws In Worksheets
If ws.Name <> ws1.Name Then
s.Copy
ws.Paste
ws.Shapes(ws.Shapes.Count).Top = s.Top
ws.Shapes(ws.Shapes.Count).Left = s.Left
End If
Next ws
Application.ScreenUpdating = True
End Sub