Copy from One Worksheet to New Workbook with Specific Image

S

ShumsFaruk

Board Regular
Joined
Jul 24, 2009
Messages
93
Good Day All,

Subject sounds familiar, but I am banging my head to get expected result.

For Copying from one worksheet to New Workbook I am using below code, which works perfect:
Code: 
With ActiveSheet.UsedRange
       .Value = .Value
End With

I have two images, one is company logo (msoPicture) & one is home button(Rounded Rectangle), when I run above code, it just copies value to value without images.

I would like to copy just Company Log to new sheet.

Please advice.
 

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.
Sort by date Sort by votes
Have you tried just copying the sheet to the new/different workbook, then doing the .Value = .Value in the destination workbook/worksheet to rid the formulas?
 
Upvote 0
GTO said:
Have you tried just copying the sheet to the new/different workbook, then doing the .Value = .Value in the destination workbook/worksheet to rid the formulas?
Click to expand...

Thanks GTO for considering,

Yes I am using below code for copying:
Code: 
'Copies the ActiveSheet to new workbook
                Ws.Copy
                With ActiveSheet.UsedRange
                    .Value = .Value
                End With
                With ActiveSheet
                    .Name = Range("K5").Value
                End With
 
Upvote 0
I even tried below with no luck:
Code: 
'Copies the ActiveSheet to new workbook
                Ws.Copy
                With ActiveSheet.UsedRange
                    .Value = .Value
                End With
                Ws.Pictures.Copy
                With ActiveSheet
                    .Parent.Activate
                    .Activate
                    .Range("A1").Select
                    .Paste
                End With
                With ActiveSheet
                    .Name = Range("K5").Value
                End With
 
Upvote 0
I may not be following, but with Ws referencing the worksheet that has the images and formulas, I would think the images will be copied. That said, I don' t know how you are setting the reference.

In a blank/new two or more sheet workbook, in Sheet1, create a few formulas that reference cells on other sheet(s). Plunk an image on Sheet1.

In a Standard Module:

<font face=Courier New><SPAN style="color:#00007F">Option</SPAN> <SPAN style="color:#00007F">Explicit</SPAN><br>  <br><SPAN style="color:#00007F">Sub</SPAN> example()<br><SPAN style="color:#00007F">Dim</SPAN> wbNew <SPAN style="color:#00007F">As</SPAN> Workbook<br><SPAN style="color:#00007F">Dim</SPAN> wks <SPAN style="color:#00007F">As</SPAN> Worksheet<br>  <br>  <SPAN style="color:#007F00">'Create a reference to a new, one-sheet workbook</SPAN><br>  <SPAN style="color:#00007F">Set</SPAN> wbNew = Workbooks.Add(xlWBATWorksheet)<br>  <br>  <SPAN style="color:#007F00">'Copy our sheet (with formulas and pictures) from ThisWorkbook to the new WB.</SPAN><br>  Sheet1.Copy After:=wbNew.Worksheets(1)<br>  <br>  <SPAN style="color:#007F00">'Delete the blank sheet in the new WB</SPAN><br>  Application.DisplayAlerts = <SPAN style="color:#00007F">False</SPAN><br>  wbNew.Worksheets(1).Delete<br>  Application.DisplayAlerts = <SPAN style="color:#00007F">True</SPAN><br>  <br>  <SPAN style="color:#007F00">'Set a reference to the created worksheet in the new WB.</SPAN><br>  <SPAN style="color:#00007F">Set</SPAN> wks = wbNew.Worksheets(1)<br>  <br>  <SPAN style="color:#007F00">'Wipe out the formulas</SPAN><br>  wks.UsedRange.Value = wks.UsedRange.Value<br>  <br>  <br><SPAN style="color:#00007F">End</SPAN> <SPAN style="color:#00007F">Sub</SPAN><br></FONT>

The image should have been copied, and the formulas should be gone in the new worksheet. Does that help?

Mark
 
Upvote 0
Thank Mark,

Below is my complete code after your help, but it doesn't work:
Code: 
Sub Printing_Invoice_To_XLS()
Dim Ws As Worksheet
Dim strPath As String
Dim myFile As Variant
Dim strFile As String
Dim NewWb As Workbook
Dim NewWs As Worksheet
On Error GoTo errHandler

'enter name and select folder for file
' start in current workbook folder
strFile = Replace(Replace(Ws.Range("K5").Value, " ", ""), ".", "_")
strFile = ThisWorkbook.Path & "\" & strFile

myFile = Application.GetSaveAsFilename(InitialFileName:=strFile, filefilter:= _
            " Excel Macro Free Workbook (*.xlsx), *.xlsx,", _
            Title:="Select Folder and FileName to save")

If myFile <> "False" Then
    Select Case LCase(Right(myFile, Len(myFile) - InStrRev(myFile, ".", , 1)))
            Case "xls": FileFormatValue = 56
            Case "xlsx": FileFormatValue = 51
            Case "xlsm": FileFormatValue = 52
            Case "xlsb": FileFormatValue = 50
            Case Else: FileFormatValue = 0
            End Select

            'Now we can create/Save the file with the xlFileFormat parameter
            'value that match the file extension
            If FileFormatValue = 0 Then
                MsgBox "Sorry, unknown file extension"
            Else

                'Create a reference to a new, one-sheet workbook
                Set Ws = Sheets("Invoice") ' change as needed
                Set NewWb = Workbooks.Add(xlWBATWorksheet)
                
                'Copies the ActiveSheet to new workbook
                Ws.Copy after:=NewWb.Worksheets(1)
                
                'Delete the blank sheet in the new WB
                Application.DisplayAlerts = False
                NewWb.Worksheets(1).Delete
                Application.DisplayAlerts = True
                
                'Set a reference to the created worksheet in the new WB.
                Set NewWs = NewWb.Worksheets(1)
                
                'Wipe out the formulas
                NewWs.UsedRange.Value = NewWs.UsedRange.Value
                                
                'rename the worksheet
                NewWs.Name = NewWs.Range("K5").Value
                
                NewWb.SaveAs myFile, FileFormat:= _
                             FileFormatValue, CreateBackup:=False
                                
                
            End If
    MsgBox "Excel file has been created."
    
End If
NewWb.Close False

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create Excel file"

    Resume exitHandler

End Sub
 
Upvote 0
At least as shown, the code should fall over (fail) at this line:
strFile = Replace(Replace(Ws.Range("K5").Value, " ", ""), ".", "_")

This is because Ws has not been Set. Does that make sense?

Mark
 
Upvote 0
OK I got it.

First I went to Excel options > Advance > Cut, copy, and paste(section) > Checked box for "Cut, copy, and sort inserted objects with their parent cells"

Then it copied every cell as value with logo & Rounded Rectangle shape.

Then I add below code to delete shape:

Code: 
Sub Printing_Invoice_To_XLS()
Dim Ws As Worksheet
Dim strPath As String
Dim myFile As Variant
Dim strFile As String
Dim NewWb As Workbook
Dim NewWs As Worksheet
On Error GoTo errHandler
Set Ws = Sheets("Invoice") ' change as needed
'enter name and select folder for file
' start in current workbook folder
strFile = Replace(Replace(Ws.Range("K5").Value, " ", ""), ".", "_")
strFile = ThisWorkbook.Path & "\" & strFile

myFile = Application.GetSaveAsFilename(InitialFileName:=strFile, filefilter:= _
            " Excel Macro Free Workbook (*.xlsx), *.xlsx,", _
            Title:="Select Folder and FileName to save")

If myFile <> "False" Then
    Select Case LCase(Right(myFile, Len(myFile) - InStrRev(myFile, ".", , 1)))
            Case "xls": FileFormatValue = 56
            Case "xlsx": FileFormatValue = 51
            Case "xlsm": FileFormatValue = 52
            Case "xlsb": FileFormatValue = 50
            Case Else: FileFormatValue = 0
            End Select

            'Now we can create/Save the file with the xlFileFormat parameter
            'value that match the file extension
            If FileFormatValue = 0 Then
                MsgBox "Sorry, unknown file extension"
            Else

                'Create a reference to a new, one-sheet workbook
                
                Set NewWb = Workbooks.Add(xlWBATWorksheet)
                
                'Copies the ActiveSheet to new workbook
                Ws.Copy after:=NewWb.Worksheets(1)
                
                'Delete the blank sheet in the new WB
                Application.DisplayAlerts = False
                NewWb.Worksheets(1).Delete
                Application.DisplayAlerts = True
                
                'Set a reference to the created worksheet in the new WB.
                Set NewWs = NewWb.Worksheets(1)
                                
                'Wipe out the formulas
                NewWs.UsedRange.Value = NewWs.UsedRange.Value
                                
                'rename the worksheet
                NewWs.Name = NewWs.Range("K5").Value
                
                'Delete Shape
                NewWs.Shapes.Range(Array("Rounded Rectangle 4")).Delete
                
                NewWb.SaveAs myFile, FileFormat:= _
                             FileFormatValue, CreateBackup:=False
                                
                
            End If
    MsgBox "Excel file has been created."
    
End If
NewWb.Close False

exitHandler:
    Exit Sub
errHandler:
    MsgBox "Could not create Excel file"

    Resume exitHandler

End Sub

Thanks again for your time.
 
Upvote 0
You must log in or register to reply here.

Similar threads

L
  • Question
Step 1: Can you Loop Through Multiple Excel worksheets in one workbook (Copy and paste all to new worksheet or Workbook)
Replies
9
Views
426
Micron
M
D
  • Question
Copying/Pasting images to the correct row/column location between two different workbooks
Replies
0
Views
256
doctorhifi
D
M
  • Question
So I tried and I am new to VBA however tried this much and this worked .I really need help.
Replies
1
Views
162
Skyybot
Skyybot
J
  • Solved
Copy specific Columns from one workbook to Another - VBA Excel
2
Replies
10
Views
510
smozgur
smozgur
C
  • Solved
Copy only required cells to new workbook
Replies
5
Views
127
MARK858
MARK858

Forum statistics

Threads
1,215,310
Messages
6,124,188
Members
449,147
Latest member
sweetkt327

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top