Débutant macro: Copier coller entre 2 classeurs !

[ju_fra]

Bjr,

Voici j'ai Deux classeurs, disons "Vieux" et "Nouveau" contenant 10 onglets nommés de la meme maniere dans "Vieux" et dans "Nouveau"

L'objectif est de transferer les données (genre copier coller) de chaque onglet du "Vieux" vers chaque onglet du "Nouveau".

MAIS le format générique des onglets a changé !

Par exemple, il faut copier les valeurs du range "BY59:CJ59" ("vieux Classeur") vers le mem range commencant en BJ59 sur le "Nouveau"


J'ai fait avec l'assistant, mais comme j'ai plein de transfert a faire, j'aimerai apprendre le truc des "Boucles"

Qui peut m'aider svp ?

 

[Compte Supprimé 979]

Re : Débutant macro: Copier coller entre 2 classeurs !

Salut Ju_Fra

Je pense que le code existe déjà sur le forum, as-tu bien cherché ?

Sinon essaye celui là

Sub CopieColleWbk()
  Dim WbkS As Workbook  ' Classeur source
  Dim WbkD As Workbook  ' Classeur de Destination
  Dim Sht As Worksheet ' Feuille source
  Dim VPathFic As String
  Dim RngS As String ' Range Source
  Dim RngD As String ' Range de Destination
  
  ' Définir la plage de destination
  RngS = "BY59:CJ59"
  RngD = "BJ59"
  
  ' Demander de choisir le classeur Source
  MsgBox "Merci de sélectionner le classeur source !"
  ' Choisir le fichier à ouvrir
  VPathFic = ChoixFichier()
  ' Si aucun fichier, alors sortir
  If VPathFic = "" Then Exit Sub
  ' Sinon ouvrir le classeur
  Workbooks.Open VPathFic
  ' Définir le classeur source
  Set WbkS = ActiveWorkbook
  
  ' Demander de choisir le classeur de Destination
  MsgBox "Merci de sélectionner le classeur de Destination !"
  ' Choisir le fichier à ouvrir
  VPathFic = ChoixFichier()
  ' Si aucun fichier, alors sortir
  If VPathFic = "" Then Exit Sub
  ' Sinon ouvrir le classeur
  Workbooks.Open VPathFic
  ' Définir le classeur de Destination
  Set WbkD = ActiveWorkbook
  ' Effectuer la copie / collage de chaque feuille
  For Each Sht In WbkS.Sheets
    WbkS.Sheets(Sht.Name).Range(RngS).Copy Destination:=WbkD.Sheets(Sht.Name).Range(RngD)
  Next Sht
  ' Message de fin
  MsgBox "La copie du classeur source vers le calsseur de destination est terminée"
  ' effacer les variables objet
  Set Sht = Nothing
  Set WbkD = Nothing
  Set WbkS = Nothing
End Sub
Function ChoixFichier()
Dim fd As FileDialog
Dim vrtSelectedItem As Variant
  Set fd = Application.FileDialog(msoFileDialogOpen)
  With fd
    If .Show = -1 Then
      ChoixFichier = fd.SelectedItems(1)
    Else
      ChoixFichier = ""
    End If
  End With
  Set fd = Nothing
End Function

A mettre dans un classeur à part si tu veux

A+

 

[ju_fra]

Re : Débutant macro: Copier coller entre 2 classeurs !

Merci !

Cependant, ta macro ne fonctionne pas car j'ai d'autres onglets sur "Vieux" et "Nouveau" qui eux ne sont pas a copier !
De plus, j'ai beacoup de range a deplacer.

Voila ma demarche, elle fonctionne, cependant ma procedure est trop grande pour excel ( Puisque c'est tres bourrin)

Windows("Vieux.xls").Activate
Sheets("Bobby").Select
Range("BY7:CJ7").Select
Selection.Copy
Windows("Nouveau.xls").Activate
Sheets("Bobby").Select
Range("E83").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Windows("Vieux.xls").Activate
Range("BY9:CJ10").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Nouveau.xls").Activate
Range("E80").Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False

Etc .... ( 30 fois ...avec des ranges differents)

Ensuite je selectionne tout le code, je le copie colle en dessous et je remplace Bobby par John ...

Puis une nouvelle fois par Jack, pui Lisa etc ( 10 changements car 10 onglets)

Au final, j'ai un code de 1640 lignes (!!!)

=> Compil error, procedure too large :s

Merci beaucoup pour l'aide ...

 

[ju_fra]

Re : Débutant macro: Copier coller entre 2 classeurs !

Svp Qqun pour m'aider ?


J'ai fait des recherches sur le forum ... sans succés !

En plus ce type de macro me sera très utile pour mon boulot et m efera gagner des heures !

Merci