Copier cellules d'une feuille vers une autre feuille d'un classeur fermé

Au lieu de les mettre en colonne A est il possible de choisir l'emplacement des plages ?

Stéphanek,

Ca n'a quand plus rien à voir avec la demande initiale

Voici le code qui fonctionne chez moi

Sub CopierCollerPlageAvecValeurEtFormat()
  Dim WbkSource As Workbook, WbkDest As Workbook
  Dim PlageACopier As Range, Plg As Range, TabRng
  Dim IndRng As Integer
  ' Définir le classeur source
  Set WbkSource = ThisWorkbook
  '
  ' Ouvrir le classeur de destination ICI
  Set WbkDest = Workbooks.Open(Filename:=ActiveWorkbook.Path & "\Classeur.xlsm")
  ' Créer une nouvelle feuille
  WbkDest.Sheets.Add After:=WbkDest.Sheets(WbkDest.Sheets.Count)
  '
  ' Mettre les plages à copier dans un tableau
  TabRng = Split("G1:J18,L3:Q18,S3:U18", ",")
  ' Pour chaque plage à copier du tableau
  For IndRng = 0 To UBound(TabRng)
    'Définir la plage à copier
    Set PlageACopier = WbkSource.ActiveSheet.Range(TabRng(IndRng))
    '
    Set Plg = Application.InputBox("Merci de choisir la cellule à partir de laquelle coller" & vbCr _
    & "la plage [" & TabRng(IndRng) & "]", "CELLULE UNIQUE", Type:=8)
    ' Copier la plage source
    PlageACopier.Copy
    ' La coller avec valeur et format
    With WbkDest.ActiveSheet
      With .Range(Plg.Address)
        .PasteSpecial Paste:=xlPasteValues
        .PasteSpecial Paste:=xlPasteFormats
      End With
    End With
  Next IndRng
  ' Fermer et enregistrer le classeur
  ' WbkDest.Close SaveChanges:=True
  ' Effacer les variables objet pour libérer la mémoire
  Set WbkDest = Nothing: Set PlageACopier = Nothing: Set WbkSource = Nothing
End Sub

A+

Je sais bien Bruno ,merci.

le code fonctionne parfaitement , mais ne peut on pas définir sans message box les plages des cellules a l'avance ?

Re

Décidément, on ne se comprend pas

Bien sur que oui, 3 plage à coller à partir de 3 cellules différentes !?

Merci d'être plus explicite la prochaine fois SVP

A+

Bonjour Bruno,

oui c'est ca.

Désolé de ne pas être assez clair dans mes explications.

Re,

Il faut dans ce cas définir le tableau source et de destination des cellules

Sub CopierCollerPlageAvecValeurEtFormat()
  Dim WbkSource As Workbook, WbkDest As Workbook
  Dim PlageACopier As Range, Plg As Range, TabDRng, TabSRng
  Dim IndRng As Integer
  ' Définir le classeur source
  Set WbkSource = ThisWorkbook
  '
  ' Ouvrir le classeur de destination ICI
  Set WbkDest = Workbooks.Open(Filename:=ActiveWorkbook.Path & "\Classeur.xlsm")
  ' Créer une nouvelle feuille
  WbkDest.Sheets.Add After:=WbkDest.Sheets(WbkDest.Sheets.Count)
  '
  ' Mettre les plages à copier dans un tableau Source
  TabSRng = Split("G1:J18,L3:Q18,S3:U18", ",")
  ' Mettre les plages à coller dans un tableau Destination
  TabDRng = Split("G1,L3,S3", ",")
  ' Pour chaque plage à copier du tableau
  For IndRng = 0 To UBound(TabSRng)
    'Définir la plage à copier
    Set PlageACopier = WbkSource.ActiveSheet.Range(TabRng(IndRng))
    ' Copier la plage source
    PlageACopier.Copy
    ' La coller avec valeur et format
    With WbkDest.ActiveSheet
      With .Range(TabDRng(IndRng))
        .PasteSpecial Paste:=xlPasteValues
        .PasteSpecial Paste:=xlPasteFormats
      End With
    End With
  Next IndRng
  ' Fermer et enregistrer le classeur
  ' WbkDest.Close SaveChanges:=True
  ' Effacer les variables objet pour libérer la mémoire
  Set WbkDest = Nothing: Set PlageACopier = Nothing: Set WbkSource = Nothing
End Sub

A voir

A+

Bruno,

J'ai un message d'erreur ?

' Mettre les plages à copier dans un tableau Source
  TabRng = Split("O1:Q2,G3:I22,G32:I45,N3:P24,N40:P47,U3:W10,U17:W22,U32:W47,AB3:AD10,AB25:AD34,AB41:AD48", ",")
  ' Mettre les plages à coller dans un tableau Destination
  TabDRng = Split("G1,B3,B23,E3,E25,H3,H11,H17,K3,K11,K21", ",")
  ' Pour chaque plage à copier du tableau
  For IndRng = 0 To UBound(TabSRng)
    'Définir la plage à copier
    Set PlageACopier = WbkSource.ActiveSheet.Range(TabRng(IndRng))
    ' Copier la plage source
    PlageACopier.Copy
    ' La coller avec valeur et format
    With WbkDest.ActiveSheet
      With .Range(TabDRng(IndRng))
        .PasteSpecial Paste:=xlPasteValues
        .PasteSpecial Paste:=xlPasteFormats
        .PasteSpecial Paste:=8
      End With

Bonjour Stéphanek

Il y a des fautes d'orthographe des variables, vous mettriez "Option Explicit" en début de module vous vous en seriez aperçu

Sub CopierCollerPlageAvecValeurEtFormat()
  Dim WbkSource As Workbook, WbkDest As Workbook
  Dim PlageACopier As Range, Plg As Range, TabDRng, TabSRng
  Dim IndRng As Integer
  ' Définir le classeur source
  Set WbkSource = ThisWorkbook
  '
  ' Ouvrir le classeur de destination ICI
  Set WbkDest = Workbooks.Open(Filename:=ActiveWorkbook.Path & "\Classeur.xlsm")
  ' Créer une nouvelle feuille
  WbkDest.Sheets.Add After:=WbkDest.Sheets(WbkDest.Sheets.Count)
  '
  ' Mettre les plages à copier dans un tableau Source
  TabSRng = Split("O1:Q2,G3:I22,G32:I45,N3:P24,N40:P47,U3:W10,U17:W22,U32:W47,AB3:AD10,AB25:AD34,AB41:AD48", ",")
  ' Mettre les plages à coller dans un tableau Destination
  TabDRng = Split("G1,B3,B23,E3,E25,H3,H11,H17,K3,K11,K21", ",")
  ' Pour chaque plage à copier du tableau
  For IndRng = 0 To UBound(TabSRng)
    'Définir la plage à copier
    Set PlageACopier = WbkSource.ActiveSheet.Range(TabSRng(IndRng))
    ' Copier la plage source
    PlageACopier.Copy
    ' La coller avec valeur et format
    With WbkDest.ActiveSheet
      With .Range(TabDRng(IndRng))
        .PasteSpecial Paste:=xlPasteValues
        .PasteSpecial Paste:=xlPasteFormats
      End With
    End With
  Next IndRng
  ' Fermer et enregistrer le classeur
  ' WbkDest.Close SaveChanges:=True
  ' Effacer les variables objet pour libérer la mémoire
  Set WbkDest = Nothing: Set PlageACopier = Nothing: Set WbkSource = Nothing
End Sub

@+

If WbkSource.Range("Q1").Value <> "" Then
    ActiveSheet.Name = WbkSource.Range("Q1").Value
 End If

Re,

Peut-être placé au bon endroit et comme ceci

 ' Créer une nouvelle feuille
  WbkDest.Sheets.Add After:=WbkDest.Sheets(WbkDest.Sheets.Count)
 ' La renommer
  If WbkSource.Range("Q1").Value <> "" Then
    WbkDest.ActiveSheet.Name = WbkSource.Range("Q1").Value
  End If

A+

Bonjour Bruno,

j'ai un message d'erreur pourtant je le place au bon endroit ??

Re,

Que contient la cellule Q1 allez au hasard un date

A+

Non même pas . J'ai fait des tests sur différentes cellules... ??

Re,

Bon pour ma part, je vais clôturer ce fil qui n'a plus lieu d'être alimenté

Si le problème persiste, merci de joindre votre fichier en n'en créant un nouveau

Merci de votre compréhension