Bereik incl.logo kopiëren op nieuw tabblad (VBA)

[peter59]

Hallo,

Ik krijg het maar niet voor elkaar om een bepaald bereikt incl. logo te kopiëren en te plakken op nieuw tabblad.
Alles lukt behalve het logo wil niet lukken.
De code is in voorbeeld bestand verwerkt.

Alvast bedankt voor het meedenken.

Mvg
Peter

 

[edmoor]

Het is een complete copy van het Invulblad, dus dit is voldoende:

Sub dupliceren_en_hernoemen()   'weekplanning
    With Sheets("Invulblad")
        If Not IsError(Evaluate("'" & .Range("C2").Value & "'!A1")) Then
            MsgBox "Tabblad """ & .Range("C2").Value & """ bestaat al."
            Exit Sub
        End If
    End With

    Worksheets.Copy After:=Sheets(Sheets.Count)
    ActiveSheet.Name = Sheets("invulblad").Range("C2")
    ActiveSheet.Shapes("CommandButton2").Delete
    'Sheets("Invulblad").Shapes("Picture 1").Copy
    'ActiveSheet.Range("A1").PasteSpecial
End Sub

Bekijk bijlage Logo Copy.xlsm

 

[HSV]

Iets anders uitgeschreven.
Ik ben te laat zie ik.

Sub dupliceren_en_hernoemen()   'weekplanning
Dim sh As Worksheet
Set sh = Sheets("Invulblad")
  If Not IsError(Evaluate("'" & sh.Range("c2").Value & "'!A1")) Then
        MsgBox "Tabblad """ & sh.Range("c2").Value & """ bestaat al."
    Else
       Sheets.Add(, Sheets(Sheets.Count)).Name = sh.Range("C2").Value
       sh.Range("A1:F13").Copy
     With Sheets(CStr(sh.Range("C2").Value)).Range("A1")
         .PasteSpecial -4104
         .PasteSpecial xlPasteColumnWidths
       End With
  sh.Shapes(1).Copy
  Sheets(CStr(sh.Range("C2").Value)).Paste
  Application.Goto Sheets(CStr(sh.Range("C2").Value)).Range("A1")
 End If
End Sub

 

[HSV]

Wat lees ik onderaan bij je aanpassing Ed? :d

Ik had in eerste instantie ook de gewone copy, maar ik dacht te menen dat de ColumnWidths niet mee ging (verkeerd gedacht).
In je hernieuwde code neem je het plaatje niet meer mee, wat je eerder wel deed.

 

[edmoor]

Plaatje gaat gewoon mee met de Worksheets.Copy
En ik heb er inderdaad een stukje van jou in verwerkt

 

[HSV]

Bij mij in Excel 2007 niet.
Ik moet met sinterklaas maar eens een nieuwere versie.

 

[edmoor]

Thuis heb ik Office 365, dat is dus 2013.
Op m'n zakelijke laptop staat Office 2000, 2003, 2007, 2010, 2013 en de 2016 preview

En aan TS:
Als het plaatje op deze manier bij jou ook niet mee komt dan hoef je alleen maar de commentaartekens voor de laatste 2 regels te verwijderen.

 

[peter59]

Hallo,

@Edmoor
In het (uitgeklede)voorbeeldbestandje werkt je code perfect maar als ik deze in mijn origineel gebruikt dan wordt, zoals je al suggereerde het hele blad en de overige tabbladen gekopieerd. Het was de bedoeling om het specifieke bereik incl logo te kopiëren aangezien het originele tabblad nog meerdere gegevens bevat.

@Harry
Jouw code werkt in het voorbeeld bestand en het origineel.

Ik wil jullie van harte bedanken voor jullie kennis en kunde en natuurlijk voor de oplossing.
Ben weer ontzettend goed geholpen.

Mvg
Peter

 

[edmoor]

En je hebt meteen de verschillende mogelijkheden gezien