Image Not Being Pasted To New Worksheet

Ark68

Well-known Member
Joined
Mar 23, 2004
Messages
4,562
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
I am attempting to copy and paste an image between workbooks. I had found code here at Mr. Excel to do that, and I adapted it to my needs, however, I'm unable to get it to work.

Rich (BB code):
With Worksheets("WPL")
            With .Range("A1")
                .PasteSpecial xlPasteColumnWidths
                .PasteSpecial xlPasteAll
            End With
            llastrow = .Range("R" & Rows.Count).End(xlUp).Row
            With .Rows("1:300")
                .RowHeight = 12.75
                .VerticalAlignment = xlCenter
            End With
            .Rows(7).RowHeight = 9.75
            .Rows(11).RowHeight = 6
            .Rows(llastrow + 3).RowHeight = 6.75
            .Rows(llastrow + 5).RowHeight = 6.75
            wshwo.Shapes("Picture 3").Copy
            .Range("A1").PasteSpecial


Copy Picture 3 from worksheet defined worksheet wshwo and paste in in the top left corner (A1) of worksheet WPL.
No image is pasted on WPL.
 

Excel Facts

Best way to learn Power Query?
Read M is for (Data) Monkey book by Ken Puls and Miguel Escobar. It is the complete guide to Power Query.
Try modifying the lines you highlighted in blue:
Code:
wshwo.Shapes("Picture 3").Copy
.Select
.Range("A1").Select
ActiveSheet.PasteSpecial
 
Upvote 0
Hi JoeMo ...

Thanks for your reply. It's not working though. :(
 
Upvote 0
Hi JoeMo ...

Thanks for your reply. It's not working though. :(
Can you be more specific about what exactly is not working? Do you get an error message, what line is highlighted ...? Can you post all of your code?
 
Upvote 0
Hi Joe ...

Simply put, the image is not being pasted on the new worksheet after it's been copied. No errors.

Here's the entire sub (which is still in development . . . so pardon the mess). The code in blue is what I went back to after your suggestion didn't do the trick. Worksheet MasterWKSH has the image, to be copied to the destination, in this case I believe is worksheet RPL.

Rich (BB code):
Sub ws_prepare()

    Dim wshpost As Worksheet
    Dim wshcore As Worksheet
    Dim wshvar As Worksheet
    Dim wshfac As Range
    Dim wshstaff As Worksheet
    
    Dim cnta As Integer
    Dim cnt_rec As Integer
    Dim cnt_rowsin As Integer
    Dim rngRIDCopy As Range
    Dim rngcore As Range
    
    Set wshpost = Worksheets("MasterWKSH")
    Set wshcore = Worksheets("CONTROL_1")
    Set wshvar = Worksheets("varhold")
    Set wshstaff = Worksheets("Staff")
    Set wshfac = Worksheets("Facilities").Range("A1:G300")
    
    cnt_rec = Application.Count(wshcore.Range("A:A"))
    cnt_rowsin = cnt_rec
    Set rngRIDCopy = wshcore.Range("A2:A" & cnt_rec + 1)
    Set rngcore = wshcore.Range("A:EH")
    
    With wshpost
    
        If .FilterMode Then .ShowAllData

        cnta = Application.Count(.Range("A:A"))
        If cnta > 0 Then
            .Rows("13:" & cnta + 12).Delete
        End If
        
        .Rows("13:" & cnt_rec + 12).Insert Shift:=xlDown
        With rngRIDCopy
            .Copy
        End With
        .Range("A13").PasteSpecial Paste:=xlPasteValues
        For i = 13 To cnt_rec + 12
            .Range("C" & i) = Application.VLookup(.Range("A" & i), rngcore, 3, False)
            .Range("D" & i) = Application.VLookup(Application.VLookup(.Range("A" & i), rngcore, 10, False), wshfac, 7, False) ' Location
            .Range("E" & i) = Application.VLookup(.Range("A" & i), rngcore, 6, False)
            .Range("F" & i) = Format(Application.VLookup(.Range("A" & i), rngcore, 14, False), "h:mm A/P")
            .Range("G" & i) = Format(Application.VLookup(.Range("A" & i), rngcore, 15, False), "h:mm A/P")
            .Range("H" & i) = Application.VLookup(.Range("A" & i), rngcore, 24, False)
            .Range("I" & i) = Application.VLookup(.Range("A" & i), rngcore, 31, False)
            .Range("J" & i) = Application.VLookup(.Range("A" & i), rngcore, 52, False)
            .Range("K" & i) = Application.VLookup(.Range("A" & i), rngcore, 55, False)
            .Range("L" & i) = Application.VLookup(.Range("A" & i), rngcore, 58, False)
            .Range("M" & i) = Application.VLookup(.Range("A" & i), rngcore, 71, False)
            .Range("N" & i) = Application.VLookup(.Range("A" & i), rngcore, 79, False)
            .Range("O" & i) = Application.VLookup(.Range("A" & i), rngcore, 87, False)
            .Range("P" & i) = Application.VLookup(.Range("A" & i), rngcore, 95, False)
            .Range("Q" & i) = Application.VLookup(.Range("A" & i), rngcore, 63, False)
            .Range("R" & i) = Application.VLookup(.Range("A" & i), rngcore, 5, False)
        Next i
        
        '** SORT **
        '.Range("A13:R" & cnt_rec + 12).Sort key1:=Range("R13"), order1:=xlAscending, key2:=Range("F13"), order2:=xlAscending, Header:=xlNo
        
        Dim oRangeSort As Range
        Dim oRangeKey As Range

        ' one range that includes all colums do sort
        Set oRangeSort = .Range("A13:R" & cnt_rec + 12)
        ' start of column with keys to sort
        Set oRangeKey = .Range("R13")

        ' custom sort order
        Dim sCustomList(1 To 6) As String
        sCustomList(1) = "DT"
        sCustomList(2) = "DR"
        sCustomList(3) = "FT"
        sCustomList(4) = "FR"
        sCustomList(5) = "CT"
        sCustomList(6) = "CR"
        
        Application.AddCustomList ListArray:=sCustomList
        ' use this if you want a list on the spreadsheet to sort by
        ' Application.AddCustomList ListArray:=Range("D1:D3")

        .Sort.SortFields.Clear
        oRangeSort.Sort Key1:=oRangeKey, Order1:=xlAscending, key2:=Range("F13"), order2:=xlAscending, Header:=xlNo, _
            OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
            Orientation:=xlTopToBottom, DataOption1:=xlSortNormal

        ' clean up
        'Application.DeleteCustomList Application.CustomListCount
        'Set oWorksheet = Nothing
        
        
        '** MISC **
        
        .Range("O4") = "MSTR"
        .Range("M4") = "MIN Start"
        .Range("P4") = "MAX End"
        .Range("M5") = Application.Min(.Range("F:F"))
        .Range("P5") = Application.Max(.Range("G:G"))
    
        '** INSERT SEPARATOR ROWS
    
        'Dim r As Long, mcol As String, h As Long
        'r = Cells(Rows.Count, "R").End(xlUp).Row
        'mcol = Cells(r, 18).Value
        'For h = r To 2 Step -1
        '    If Cells(h, 18).Value <> mcol Then
        '        mcol = Cells(h, 18).Value
        '        Rows(h + 1).Insert
        '    End If
        'Next h

        '** PREPARE INDIVIDUAL WORKSHEETS **
        
        Worksheets.Add(After:=Worksheets(13)).Name = "WPL"
        'Worksheets.Add(After:=Worksheets(13)).Name = "WPE"
        Worksheets.Add(After:=Worksheets(13)).Name = "RPL"
        'Worksheets.Add(After:=Worksheets(13)).Name = "RPE"
        'Worksheets.Add(After:=Worksheets(13)).Name = "HPL"
        'Worksheets.Add(After:=Worksheets(13)).Name = "HPE"
        'Worksheets.Add(After:=Worksheets(13)).Name = "CUL"
        Worksheets.Add(After:=Worksheets(13)).Name = "CUE"
        
        '** POPULATE WORKSHEETS
        
        .Range("H12") = "Groom"
        .Range("I12") = "Prepare"
        .Range("J12") = "Signature"
        .Range("K12") = "Lights On"
        .Range("L12") = "Lights Off"
        .Range("M12") = "1"
        .Range("N12") = "2"
        .Range("O12") = "3"
        .Range("P12") = "4"
        .Range("Q12") = "Close"
        
        If .FilterMode Then .ShowAllData
        llastrow = .Range("R" & Rows.Count).End(xlUp).Row
        
        'RPL
        wshvar.Range("I27") = Worksheets("Staff").Range("B18")
        With .Range("A12:R" & llastrow)
            .AdvancedFilter _
                Action:=xlFilterInPlace, _
                CriteriaRange:=wshvar.Range("I28:R38"), _
                Unique:=False
            On Error Resume Next
        End With
        Worksheets("MasterWKSH").Range("A1:R300").Copy
        With Worksheets("RPL")
            With .Range("A1")
                .PasteSpecial xlPasteColumnWidths
                .PasteSpecial xlPasteAll
            End With
            llastrow = .Range("R" & Rows.Count).End(xlUp).Row
            With .Rows("1:300")
                .RowHeight = 12.75
                .VerticalAlignment = xlCenter
            End With
            .Rows(7).RowHeight = 9.75
            .Rows(11).RowHeight = 6
            .Rows(llastrow + 3).RowHeight = 6.75
            .Rows(llastrow + 5).RowHeight = 6.75
            wshwo.Shapes("Picture 3").Copy
            Worksheets("RPL").Range("A1").PasteSpecial
            
            .Range("M1") = Format(wshcore.Range("B2"), "dddd, mmmm dd, yyyy")
            .Range("M4") = wshvar.Range("I27")
            .Range("O4") = Application.VLookup(.Range("M4"), wshstaff.Range("L4:M20"), 2, False)
            .Range("P4") = Application.VLookup("RPL1", wshcore.Range("BA:DJ"), 58, False)
            .Range("M5") = Format(Application.VLookup("RPL1", wshcore.Range("BA:DJ"), 61, False), "h:mmA/P") & " - " & Format(Application.VLookup("RPL1", wshcore.Range("BA:DJ"), 62, False), "h:mmA/P")
            .Range("P5") = Format(Application.VLookup("RPL1", wshcore.Range("BA:DJ"), 59, False), "h:mmA/P") & "-" & Format(Application.VLookup("RPL1", wshcore.Range("BA:DJ"), 60, False), "h:mmA/P")
            
            With .Range("H13:Q" & llastrow)
                .FormatConditions.Add Type:=xlCellValue, Operator:=xlNotEqual, _
                    Formula1:="=varhold!$I$27"
                .FormatConditions(.FormatConditions.Count).SetFirstPriority
                With .FormatConditions(1).Interior
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorLight1
                    .TintAndShade = 0.499984740745262
                End With
                With .FormatConditions(1).Font
                    .ThemeColor = xlThemeColorLight1
                    .TintAndShade = 0.499984740745262
                End With
                .FormatConditions(1).StopIfTrue = False
                .FormatConditions.Add Type:=xlCellValue, Operator:=xlEqual, _
                    Formula1:="=varhold!$I$27"
                .FormatConditions(.FormatConditions.Count).SetFirstPriority
                With .FormatConditions(1).Font
                    .ThemeColor = xlThemeColorDark1
                    .TintAndShade = 0
                End With
                .FormatConditions(1).StopIfTrue = False
            End With
        
        
        
        End With
    End With
    

End Sub
 
Upvote 0
Hi Joe ...

Simply put, the image is not being pasted on the new worksheet after it's been copied. No errors.

Worksheet MasterWKSH has the image, to be copied to the destination, in this case I believe is worksheet RPL.
Maybe I'm missing something, but if the picture is on MasterWKSH
and your code:
Set wshpost = Worksheets("MasterWKSH")

establishes that worksheet, then what does this do:
wshwo.Shapes("Picture 3").Copy

shouldn't it be: wshpost.Shapes("Picture 3").Copy ??
 
Upvote 0
Yes Joe ... you caught it!
Awesome!
 
Upvote 0

Forum statistics

Threads
1,213,538
Messages
6,114,218
Members
448,554
Latest member
Gleisner2

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