Copier/Coller d'un classeur dans un autre
Bonjour,
J'ai trouvé plein d'infos sur ce que je cherche, mais je n'arrive pas à faire quelque chose de simple.
Voilà, je souhaite, les deux classeurs étant dans le même répertoire,
- à l'ouverture du classeur "destination" tester la présence du classeur "source" dans le répertoire.
- si "source" est présent, copier le contenu de la feuille "a_copier" depuis la cellule A3, jusqu’à la dernière ligne et colonne utilisées
- coller dans la cellule A4 de la feuille "a_coller" du classeur "destination"
1/ J'ai bien écrit quelques lignes de code, mais ça n'est vraiment pas top
2/ Ces deux fichiers sont simplifiés à l’extrême, les données à copier sont plus importantes..
3/ Il est important de partir d'une cellule donnée, car je ne tiens pas à copier toute la feuille.
Si une bonne fée pouvait se pencher sur mon cas, ça occuperait ce dimanche gris qui s'annonce
Merci !
Bonjour BastLat,
Voilà un début de solution:
Public Sub copierValeurs(ByVal plageACopier As String, ByVal classeur1 As String, ByVal nomFeuille1 As String, ByVal celluleArrivee As String, ByVal classeur2 As String, ByVal nomFeuille2 As String)
Workbooks(classeur1).Activate
Workbooks(classeur1).Worksheets(nomFeuille1).Select
Workbooks(classeur1).Worksheets(nomFeuille1).Range(plageACopier).Select
Selection.Copy
Workbooks(classeur2).Activate
Workbooks(classeur2).Worksheets(nomFeuille2).Select
Workbooks(classeur2).Worksheets(nomFeuille2).Range(celluleArrivee).Select
ActiveSheet.Paste
End Sub
Public Sub main()
Call copierValeurs("A1:A25", "Classeur1", "Feuil1", "A2", "Classeur2", "Feuil2")
'A remplacer par ce que tu veux ;)
End Sub
Function BookOpen(strBookName As String) As Boolean
Dim oBk As Workbook
On Error Resume Next
Set oBk = Workbooks(strBookName)
On Error GoTo 0
If oBk Is Nothing Then
BookOpen = False
Else
BookOpen = True
End If
End Function
Voilà un code qui copie le contenue de: Classeur1->Feuil1->Cellules A1 à A25 vers Classeur2 -> Feuil2 -Cellule A2
Maintenant vis-à-vis de ce que tu cherches, il faut que tu crée un test dans la procédure Workbook_Open et y insérer ton test. Voilà un premier jet qui sera a priori non fonctionnel (à adapter) dans "ThisWorkbook':
Private Sub Workbook_Open()
if BookOpen("source.xlsm") then
call copierValeurs("A3:Z125","source.xlsm",etc........)
end if
End Sub
PS: La fonction pour tester l'ouverture d'un classeur n'est pas de moi ^^
Bref tiens moi au courant si ça pourrait te convenir
d3d9x a écrit :Bonjour BastLat,
Voilà un début de solution.....
Bref tiens moi au courant si ça pourrait te convenir
Merci d3d9x ! J'ai adapté, et ça marche impeccablement bien !
Alors au risque d'abuser, pourrais tu m'indiquer, au moment ou on appelle:
Call copierValeurs("A1:A25", "source.xlsm", "a_copier", "A2", "destination.xlsm", "a_coller")
Comment demander dans [copierValeurs("A1:A25",...], non pas A25, mais la cellule qui correspond à la dernière ligne et de la dernière colonne utilisées de la feuille ?
J'utilise par exemple ceci pour déterminer la dernière ligne d'une feuille:
ligne = Range("D65536").End(xlUp).Offset(1, 0).Row
Mais après... Je cale
Voilà une version adaptée à ton besoin. Elle part de la case A1 jusqu'à la dernière cellule de la dernière ligne/colonne
Public Sub copierValeurs(ByVal classeur1 As String, ByVal nomFeuille1 As String, ByVal celluleArrivee As String, ByVal classeur2 As String, ByVal nomFeuille2 As String)
Dim lastLigne As Long
Dim lastColonne As Long
lastLigne = Range("D65536").End(xlUp).Offset(1, 0).Row
lastColonne = 25 ' <--------------- A CHANGER
Workbooks(classeur1).Activate
Workbooks(classeur1).Worksheets(nomFeuille1).Select
Workbooks(classeur1).Worksheets(nomFeuille1).Range(Cells(1, 1), Cells(lastLigne, lastColonne)).Select
Selection.Copy
Workbooks(classeur2).Activate
Workbooks(classeur2).Worksheets(nomFeuille2).Select
Workbooks(classeur2).Worksheets(nomFeuille2).Range(celluleArrivee).Select
ActiveSheet.Paste
End Sub
Public Sub main()
Call copierValeurs("Classeur1", "Feuil1", "A2", "Classeur2", "Feuil2")
'A remplacer par ce que tu veux ;)
End Sub
Il faut que tu édites le code pour calculer la dernière colonne!!!!!!!!!!!! (lastColonne = .......)
J'attends ton retour
d3d9x a écrit :Voilà une version adaptée à ton besoin. .....
J'attends ton retour
Et bien voici mon retour
J'ai un peu modifié et simplifié (pour moi...)
Et ça fonctionne impec !
Je vérifie qu'un fichier Source est présent dans le même répertoire:
Sub outhé()
Dim Msg, Title
Dim Path_name As String
Dim File_name As String
Dim Complete_File_name As String
Title = "Mise à Jour possible " ' Définit le titre.
File_name = "fichier_source.xlsm"
Path_name = ThisWorkbook.Path
Complete_File_name = Path_name & "\" & File_name
Msg = "Un fichier nommé:" & Chr(10) & "[" & File_name & "]" & Chr(10) & _
"existe dans ce répertoire." & Chr(10) & Chr(10) & _
"Souhaitez vous effectuer une mise à jour ?"
Dim rep As Integer
rep = msgbox(Msg, vbYesNo + vbQuestion, Title)
If rep = vbYes Then
' ici le traitement si réponse positive
Call MaJ
Else
' ici le traitement si réponse négative
End If
End If
End Sub
S'il est présent, et que l'utilisateur souhaite faire une mise à jour, je lance la Sub MaJ:
Sub MaJ()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Call copierValeurs("A3:D8", "fichier_source.xlsm", "feuille_source", "A1", "fichier_destination.xlsm", "feuille_destination")
'Appel d'autres procédures..
Application.DisplayAlerts = True
Application.ScreenUpdating = True
msgbox ("Préparation du tableau terminée")
End Sub
Qui elle même appelle la copie de la plage:
Public Sub copierValeurs(ByVal plageACopier As String, _
ByVal classeur1 As String, _
ByVal nomFeuille1 As String, _
ByVal celluleArrivee As String, _
ByVal classeur2 As String, _
ByVal nomFeuille2 As String)
Dim NomFich
Dim DerLig As Long
Dim DerCol As Long
Adresse = ThisWorkbook.Path
NomFich = classeur1
Workbooks.Open Filename:=Adresse & "\" & NomFich
Workbooks(classeur1).Activate
Workbooks(classeur1).Worksheets(nomFeuille1).Select
With Workbooks(classeur1).Worksheets(nomFeuille1)
DerLig = .Cells.SpecialCells(xlCellTypeLastCell).Row
DerCol = .Cells.SpecialCells(xlCellTypeLastCell).Column
End With
Workbooks(classeur1).Worksheets(nomFeuille1).Range(("A18"), Cells(DerLig, DerCol)).Select
Selection.Copy
Workbooks(classeur2).Activate
Workbooks(classeur2).Worksheets(nomFeuille2).Select
Workbooks(classeur2).Worksheets(nomFeuille2).Range(celluleArrivee).Select
ActiveSheet.Paste
Workbooks(classeur1).Close
End Sub
Merci pour ton aide.
(je pense que ça doit vous faire sourire, mais pour moi, c'était une MONTAGNE