Jul 18 2021 10:01 AM
Hey everyone,
I have an excel file with several formulas taking data from another "raw" excel file.
This excel file is basically doing all the necessary calculations and automatically putting all numbers in the right places. This first stage is done and complete.
On the next and final stage, I need to select only the relevant data (active rows) + a logo image, and copy paste it in a new "clean" workbook.
Now, I have all of this done, except the image which I'm not finding a solution to copy it so far.
I'm running a few statements for this in a specific order and the last one, to copy paste values, is as follows:
Sub CopyToNew()
ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy
Workbooks.Add
Range("A1").PasteSpecial xlPasteColumnWidths
Range("A1").PasteSpecial xlPasteValues
Range("A1").PasteSpecial xlPasteFormats
End Sub
Is there a way to include the copy paste of the image on the statement above or create an additional one which is compatible?
The image is somewhere between cell B112:B115 and is called "Picture 4".
Thanks!
João
Jul 18 2021 12:53 PM
SolutionFor example:
Sub CopyToNew()
Dim w1 As Worksheet
Dim wb As Workbook
Dim w2 As Worksheet
Set w1 = ActiveSheet
w1.UsedRange.SpecialCells(xlCellTypeVisible).Copy
Set wb = Workbooks.Add
Set w2 = wb.Worksheets(1)
w2.Range("A1").PasteSpecial xlPasteColumnWidths
w2.Range("A1").PasteSpecial xlPasteValues
w2.Range("A1").PasteSpecial xlPasteFormats
w1.Shapes("Picture 4").Copy
w2.Paste
End Sub
Jul 19 2021 03:14 AM
@Hans Vogelaar this is great thanks.
For it to be final, I just need to paste the image on a specific coordinate or cell, currently its pasting in the top left corner (A1).
Also, I just noticed now there was actually another image in the excel file, so I made a quick addition to what you provided me:
Sub CopyToNew()
Dim w1 As Worksheet
Dim wb As Workbook
Dim w2 As Worksheet
Set w1 = ActiveSheet
w1.UsedRange.SpecialCells(xlCellTypeVisible).Copy
Set wb = Workbooks.Add
Set w2 = wb.Worksheets(1)
w2.Range("A1").PasteSpecial xlPasteColumnWidths
w2.Range("A1").PasteSpecial xlPasteValues
w2.Range("A1").PasteSpecial xlPasteFormats
w1.Shapes("Picture 4").Copy
w2.Paste
w1.Shapes("Gerade Verbindung 3").Copy
w2.Paste
End Sub
Jul 19 2021 04:03 AM
I hope you can modify the following version for your situation:
Sub CopyToNew()
Dim w1 As Worksheet
Dim wb As Workbook
Dim w2 As Worksheet
Set w1 = ActiveSheet
w1.UsedRange.SpecialCells(xlCellTypeVisible).Copy
Set wb = Workbooks.Add
Set w2 = wb.Worksheets(1)
w2.Range("A1").PasteSpecial xlPasteColumnWidths
w2.Range("A1").PasteSpecial xlPasteValues
w2.Range("A1").PasteSpecial xlPasteFormats
w1.Shapes("Picture 4").Copy
w2.Paste
With w2.Shapes("Picture 4")
' Change cell as needed
.Top = w2.Range("B112").Top
.Left = w2.Range("B112").Left
End With
w1.Shapes("Gerade Verbindung 3").Copy
w2.Paste
With w2.Shapes("Gerade Verbindung 3")
' Change cell as needed
.Top = w2.Range("D75").Top
.Left = w2.Range("D75").Left
End With
End Sub
Jul 19 2021 04:41 AM
Jul 19 2021 06:05 AM
Strange - when I tested the code, it ran without errors. The copied/pasted shapes kept the same names as the original.
Jul 19 2021 08:23 AM
Could you attach a sample workbook that demonstrates the problem?
Jul 21 2021 08:53 AM - edited Jul 21 2021 09:14 AM
Well this is interesting... I had to strip the file so I could share it as you've requested, because of private information, and when I finished and tested the last code it works..
I'm assuming it's something not compatible with what I had before so I'll look deeper into it, but I have no idea what might be.
Edit: There was some issue with the name of the image, I just changed it and it works perfectly.
Thank you so much @Hans Vogelaar! Your help was really really appreciated!
Jul 18 2021 12:53 PM
SolutionFor example:
Sub CopyToNew()
Dim w1 As Worksheet
Dim wb As Workbook
Dim w2 As Worksheet
Set w1 = ActiveSheet
w1.UsedRange.SpecialCells(xlCellTypeVisible).Copy
Set wb = Workbooks.Add
Set w2 = wb.Worksheets(1)
w2.Range("A1").PasteSpecial xlPasteColumnWidths
w2.Range("A1").PasteSpecial xlPasteValues
w2.Range("A1").PasteSpecial xlPasteFormats
w1.Shapes("Picture 4").Copy
w2.Paste
End Sub