Copier coller compliqué

Bonjour,

Je souhaiterais copier coller quelques valeurs d'un classeur à l'autre pour les onglets ayant le même nom.

Les cellules à copier sont les cellules de D2 à D7.

Depuis le fichier "ENTREE" je voudrais retrouver les mêmes chiffres dans les onglets ayant le même nom dans le fichier "SORTIE".

En envisageant la possibilité qu'il n'y ait pas toujours les mêmes onglets, ou à la même place...

Les 2 premiers onglets (Recap1 et Recap2) et les 2 derniers (Recap3 et Recap4) ne sont pas concernés par ce copier coller.

J'ai joint des fichiers test car mes fichiers sont trop lourds...

Quelqu'un aurait une idée ?

Merci beaucoup, vous me sauveriez la vie

Cordialement

Martin

15sortie.xlsx (11.44 Ko)
18entree.xlsx (12.79 Ko)

Bonjour,

Voici un exemple de code

Sub CopierCollerValeurs()
  Dim ShtE As Worksheet, WbkE As Workbook
  Dim WbkS As Workbook
  Dim sPath As String
  ' Définir le cehmin d'accès
  sPath = ThisWorkbook.Path & "\"
  ' Ouvrir le fichier des entrées
  Set WbkE = Workbooks.Open(sPath & "ENTREE.xlsx")
  ' Ouvrir le fichier des sorties
  Set WbkS = Workbooks.Open(sPath & "SORTIE.xlsx")
  ' Pour chaque feuille du classeur ENTREE
  For Each ShtE In WbkE.Sheets
    ' S'il ne s'agit pas d'une feuille RECAP
    If InStr(1, ShtE.Name, "recap", vbTextCompare) = 0 Then
      ' Copier/coller sans erreur : si la feuille n'existe pas
      On Error Resume Next
      ShtE.Range("D2:D7").Copy Destination:=WbkS.Sheets(ShtE.Name).Range("D2:D7")
      On Error GoTo 0
    End If
  Next ShtE
  ' Petit message
  MsgBox "C'est fini !", vbInformation, "TERMINÉ"
  ' On peut fermer les classeurs ICI
  WbkS.Close SaveChanges:=vbYes
  WbkE.Close
  ' Effacer les variables objet
  Set WbkS = Nothing
  Set ShtE = Nothing: WbkE = Nothing
End Sub

A+

Bonjour,

[Suite MP] : adaptation de la macro de ton sujet précédent à ta nouvelle configuration...

Sub Transfert()
    Dim tft(), i%, f%, wb As Workbook
    On Error GoTo nowb
    Set wb = Workbooks("Sortie.xlsx")
    On Error GoTo 0
    ReDim tft(6, 0)
    With ThisWorkbook
        For f = 1 To .Worksheets.Count
            Select Case .Worksheets(f).Name
                Case "Recap1", "Recap2", "Recap3", "Recap4"
                Case Else
                    tft(0, 0) = tft(0, 0) + 1
                    ReDim Preserve tft(6, tft(0, 0))
                    With .Worksheets(f)
                        tft(0, tft(0, 0)) = .Name
                        For i = 1 To 6
                            tft(i, tft(0, 0)) = .Cells(i + 1, 4)
                        Next i
                    End With
            End Select
        Next f
    End With
    For f = 1 To tft(0, 0)
        On Error Resume Next
        With wb.Worksheets(tft(0, f))
            If Err.Number <> 0 Then
                Err.Clear: GoTo nofeuil
            End If
            For i = 1 To 6
                .Cells(i + 1, 4) = tft(i, f)
            Next i
        End With
nofeuil:
    Next f
    Exit Sub
nowb:
    'Set wb = Workbooks.Open("chemin\Sortie.xlsx")
    'Resume Next
End Sub

Même schéma. Macro dans le classeur Entrée.

Cordialement.

Bonjour,

perso... je boycotte ce sujet !!!

déjà posté sur un autre forum...

P.

Ah merci Patrick1957,

J'avais un code à proposer, mais comme toi je vais boycotter.

Puis des membres de qualité ont déjà répondu !!

Merci beaucoup à tous les 2 !

C'est bon j'ai adapté à mes vrais fichiers et tout fonctionne !

Je suis prêt pour la présentation demain matin devant les chefs Ouf !!!

Merci encore

Cordialement

Martin


On ne peut pas poster sur plusieurs forum ?

Ma demande était vraiment urgente, je ne savais pas quoi faire d'autre...

Bonne journée à tous !

Martin

Re,

mrtgrdn a écrit :

On ne peut pas poster sur plusieurs forum ?

Ma demande était vraiment urgente, je ne savais pas quoi faire d'autre...

Martin

On peut poster sur plusieurs forums, mais il est de bienséance de l'indiquer

C'est noté, je le saurai !

Merci

Martin

Il est clair que la majorité préfère que les choses soient claires dès le départ !

Ayant été sollicité sur une solution antérieure pour ce qu'on peut considérer comme le même sujet un peu modifié, j'aurais de toutes façons normalement répondu dans ce cadre [j'assure toujours la "maintenance" d'un code que j'ai produit tant que je peux considérer que le cadre de mon intervention demeure...]

Mais les pratiques "tous azimuths" font qu'à l'avenir on y regarde à deux fois (ou plus) avant de répondre...

Cordialement.

Rechercher des sujets similaires à "copier coller complique"