crazyeyeschase
Board Regular
- Joined
- May 6, 2014
- Messages
- 104
- Office Version
- 365
- Platform
- Windows
I am wanting to copy a range of images from one WB to another.
I am going to try to explain this as best as i can .
WB1 for example is the WB with the images and WB2 is where the images need to be copied to.
Inside of WB2 i have the Cells set so A1:A6 contain the Picture name and B1:B6 is where i want the pictures copied.
Example:
Inside WB1 is the exact same setup but it included the images
Example:
This is the Code i have came up with to get at least one image to be copied
This works fine however i am wanting the macro to get the value/text from each cell in A1:A6 and use that value as the picture name and then paste each picture in the correct position from B1:b6.
I am sorry if i didnt explain this good enough. This is just a test swatch when/if i get this figured out it will be for a much larger project.
I am going to try to explain this as best as i can .
WB1 for example is the WB with the images and WB2 is where the images need to be copied to.
Inside of WB2 i have the Cells set so A1:A6 contain the Picture name and B1:B6 is where i want the pictures copied.
Example:

Inside WB1 is the exact same setup but it included the images
Example:

This is the Code i have came up with to get at least one image to be copied
Code:
Sub GetPics()
Dim PicRange As Range
Dim PicName As String
Set PicRange = Range("A1")
PicName = PicRange
Application.ScreenUpdating = False
Application.Workbooks.Open (ThisWorkbook.Path & _
Application.PathSeparator & "Test2.xlsm")
Sheets("Pictures").Select
ActiveSheet.Shapes.Range(Array(PicName)).Select
Selection.Copy
Windows("Test1.xlsm").Activate
Range("B1").Select
ActiveSheet.Paste
MsgBox "IMG Copied"
Workbooks("Test2.xlsm").Activate
ActiveWorkbook.Save
ActiveWorkbook.Close
Application.ScreenUpdating = True
End Sub
This works fine however i am wanting the macro to get the value/text from each cell in A1:A6 and use that value as the picture name and then paste each picture in the correct position from B1:b6.
I am sorry if i didnt explain this good enough. This is just a test swatch when/if i get this figured out it will be for a much larger project.