Copier données d'un autre tableau en fonction du nom d'un onglet
Résolu
monza86
Messages postés
9
Date d'inscription
Statut
Membre
Dernière intervention
-
ccm81 Messages postés 10909 Date d'inscription Statut Membre Dernière intervention -
ccm81 Messages postés 10909 Date d'inscription Statut Membre Dernière intervention -
A voir également:
- Copier données d'un autre tableau en fonction du nom d'un onglet
- Tableau word - Guide
- Fonction si et - Guide
- Trier un tableau excel - Guide
- Tableau ascii - Guide
- Rouvrir un onglet fermé - Guide
14 réponses
Bonjour
1. Ouvrir les deux fichiers avec la même session d'excel
2. Se placer dans le fichier source (2016)
3. Alt-F11 pour accéder à l'editeur vba
4. Coller tout le code ci dessous
5. adapter les noms de fichier
6. Exécuter la macro OK
Un exemple (Ctrl+k pour lancer la macro depuis 2016)
fichier 2016
http://www.cjoint.com/c/GBknvItrpDf
fichier 2017
http://www.cjoint.com/c/GBknwAjq3Of
Cdlmnt
1. Ouvrir les deux fichiers avec la même session d'excel
2. Se placer dans le fichier source (2016)
3. Alt-F11 pour accéder à l'editeur vba
4. Coller tout le code ci dessous
5. adapter les noms de fichier
6. Exécuter la macro OK
Option Explicit ' adapter les noms des deux fichiers Const WS = "2016.xls" Const wb = "2017.xls" ' cellule à traiter dans chaque feuille Const cel = "$G$7" Public Sub OK() Dim wbs As Workbook, wbb As Workbook Dim nuf As Long, nbf As Long, nomf As String Set wbs = Workbooks(WS) Set wbb = Workbooks(wb) With ActiveWorkbook nbf = .Sheets.Count For nuf = 1 To nbf nomf = .Sheets(nuf).Name If FeuilleExiste(wbb, nomf) Then wbb.Sheets(nomf).Range(cel).Value = .Sheets(nomf).Range(cel).Value End If Next nuf End With End Sub Public Function FeuilleExiste(wb As Workbook, nomf As String) As Boolean Dim a FeuilleExiste = False On Error GoTo fin a = wb.Sheets(nomf).Range("A1") FeuilleExiste = True fin: End Function
Un exemple (Ctrl+k pour lancer la macro depuis 2016)
fichier 2016
http://www.cjoint.com/c/GBknvItrpDf
fichier 2017
http://www.cjoint.com/c/GBknwAjq3Of
Cdlmnt
Super merci.
On est proche de ce que je cherche à faire.
J'aimerais copier dans le fichier 2017 en case g3, la valeur de la case g7 du fichier 2016.
Je suppose que dans le code, je remplace les noms de fichier par le chemin d'accès sur mon pc?
Encore merci pour la diligence de la réponse
On est proche de ce que je cherche à faire.
J'aimerais copier dans le fichier 2017 en case g3, la valeur de la case g7 du fichier 2016.
Je suppose que dans le code, je remplace les noms de fichier par le chemin d'accès sur mon pc?
Encore merci pour la diligence de la réponse
1. J'aimerais copier dans le fichier 2017 en case g3, la valeur de la case g7 du fichier 2016.
2. Je suppose que dans le code, je remplace les noms de fichier par le chemin d'accès sur mon pc?
non, les deux fichier étant ouverts dans la même session d'ecxcel, seul le nom avec l'extension (sans le chemin) suffit
Cdlmnt
' adapter les noms des deux fichiers Const WS = "2016.xls" Const wb = "2017.xls" ' cellule à traiter dans chaque feuille Const cels = "$G$7" Const celb = "$G$3" Public Sub OK() Dim wbs As Workbook, wbb As Workbook Dim nuf As Long, nbf As Long, nomf As String Set wbs = Workbooks(WS) Set wbb = Workbooks(wb) With ActiveWorkbook nbf = .Sheets.Count For nuf = 1 To nbf nomf = .Sheets(nuf).Name If FeuilleExiste(wbb, nomf) Then wbb.Sheets(nomf).Range(celb).Value = .Sheets(nomf).Range(cels).Value End If Next nuf End With End Sub
2. Je suppose que dans le code, je remplace les noms de fichier par le chemin d'accès sur mon pc?
non, les deux fichier étant ouverts dans la même session d'ecxcel, seul le nom avec l'extension (sans le chemin) suffit
Cdlmnt
Vous n’avez pas trouvé la réponse que vous recherchez ?
Posez votre question
Tu n'as pas pris la bonne version (voir post#3)
wbb.Sheets(nomf).Range(celb).Value = .Sheets(nomf).Range(cels).Value
Cdlmnt
wbb.Sheets(nomf).Range(celb).Value = .Sheets(nomf).Range(cels).Value
Cdlmnt
Ah ok merci,
le premier code fonctionnait mais qu'avec la case G7. Le second ne fonctionnait pas. Donc j'avais essayé de faire fonctionner le premier avec les variables du second.
Là, j'ai repris le second mais il ne fonctionne pas :(
j'ai encore fait une mauvaise manip?
merci pour la patience en tout cas :)

le premier code fonctionnait mais qu'avec la case G7. Le second ne fonctionnait pas. Donc j'avais essayé de faire fonctionner le premier avec les variables du second.
Là, j'ai repris le second mais il ne fonctionne pas :(
j'ai encore fait une mauvaise manip?
merci pour la patience en tout cas :)

Ben, tu n'as pas copié le code de la fonction FeuilleExiste, donc il ne la trouve pas ;-()
Cdlmnt
Public Function FeuilleExiste(wb As Workbook, nomf As String) As Boolean Dim a FeuilleExiste = False On Error GoTo fin a = wb.Sheets(nomf).Range("A1") FeuilleExiste = True fin: End Function
Cdlmnt
Voici le code que j'ai adapté à mon fichier :
Option Explicit
' adapter les noms des deux fichiers
Const WS = "2016controleGLparastat.xlsx"
Const wb = "2017controleGLparastat.xlsm"
' cellule à traiter dans chaque feuille
Const cels = "$G$17"
Const celb = "$G$3"
Public Sub MAJ_17()
Dim wbs As Workbook, wbb As Workbook
Dim nuf As Long, nbf As Long, nomf As String
Set wbs = Workbooks(WS)
Set wbb = Workbooks(wb)
With ActiveWorkbook
nbf = .Sheets.Count
For nuf = 1 To nbf
nomf = .Sheets(nuf).Name
If FeuilleExiste(wbb, nomf) Then
wbb.Sheets(nomf).Range(celb).Value = .Sheets(nomf).Range(cels).Value
End If
Next nuf
End With
End Sub
Public Function FeuilleExiste(wb As Workbook, nomf As String) As Boolean
Dim a
FeuilleExiste = False
On Error GoTo fin
a = wb.Sheets(nomf).Range("A1")
FeuilleExiste = True
fin:
End Function
Il prend donc la valeur G17 dans le fichier 2017 pour la mettre en g3 dans ce même fichier 2017. Hors c'est la valeur g17 du fichier 2016 dont j'ai besoin
on va y arriver :p
Option Explicit
' adapter les noms des deux fichiers
Const WS = "2016controleGLparastat.xlsx"
Const wb = "2017controleGLparastat.xlsm"
' cellule à traiter dans chaque feuille
Const cels = "$G$17"
Const celb = "$G$3"
Public Sub MAJ_17()
Dim wbs As Workbook, wbb As Workbook
Dim nuf As Long, nbf As Long, nomf As String
Set wbs = Workbooks(WS)
Set wbb = Workbooks(wb)
With ActiveWorkbook
nbf = .Sheets.Count
For nuf = 1 To nbf
nomf = .Sheets(nuf).Name
If FeuilleExiste(wbb, nomf) Then
wbb.Sheets(nomf).Range(celb).Value = .Sheets(nomf).Range(cels).Value
End If
Next nuf
End With
End Sub
Public Function FeuilleExiste(wb As Workbook, nomf As String) As Boolean
Dim a
FeuilleExiste = False
On Error GoTo fin
a = wb.Sheets(nomf).Range("A1")
FeuilleExiste = True
fin:
End Function
Il prend donc la valeur G17 dans le fichier 2017 pour la mettre en g3 dans ce même fichier 2017. Hors c'est la valeur g17 du fichier 2016 dont j'ai besoin
on va y arriver :p
Je viens de corriger un élément,
Option Explicit
' adapter les noms des deux fichiers
Const WS = "2016controleGLparastat.xlsm"
Const wb = "2017controleGLparastat.xlsm"
' cellule à traiter dans chaque feuille
Const cels = "$G$17"
Const celb = "$G$3"
Public Sub MAJ_17()
Dim wbs As Workbook, wbb As Workbook
Dim nuf As Long, nbf As Long, nomf As String
Set wbs = Workbooks(WS)
Set wbb = Workbooks(wb)
With ActiveWorkbook
nbf = .Sheets.Count
For nuf = 1 To nbf
nomf = .Sheets(nuf).Name
If FeuilleExiste(wbb, nomf) Then
wbb.Sheets(nomf).Range(celb).Value = wbs.Sheets(nomf).Range(cels).Value
End If
Next nuf
End With
End Sub
Public Function FeuilleExiste(wb As Workbook, nomf As String) As Boolean
Dim a
FeuilleExiste = False
On Error GoTo fin
a = wb.Sheets(nomf).Range("A1")
FeuilleExiste = True
fin:
End Function
Elle a tourné et fonctionné mais j'ai un message d'erreur
Erreur d'exécution '9':
L'indice n'appartient pas à la sélection
et la ligne
wbb.Sheets(nomf).Range(celb).Value = wbs.Sheets(nomf).Range(cels).Value
est en surbrillance jaune
Option Explicit
' adapter les noms des deux fichiers
Const WS = "2016controleGLparastat.xlsm"
Const wb = "2017controleGLparastat.xlsm"
' cellule à traiter dans chaque feuille
Const cels = "$G$17"
Const celb = "$G$3"
Public Sub MAJ_17()
Dim wbs As Workbook, wbb As Workbook
Dim nuf As Long, nbf As Long, nomf As String
Set wbs = Workbooks(WS)
Set wbb = Workbooks(wb)
With ActiveWorkbook
nbf = .Sheets.Count
For nuf = 1 To nbf
nomf = .Sheets(nuf).Name
If FeuilleExiste(wbb, nomf) Then
wbb.Sheets(nomf).Range(celb).Value = wbs.Sheets(nomf).Range(cels).Value
End If
Next nuf
End With
End Sub
Public Function FeuilleExiste(wb As Workbook, nomf As String) As Boolean
Dim a
FeuilleExiste = False
On Error GoTo fin
a = wb.Sheets(nomf).Range("A1")
FeuilleExiste = True
fin:
End Function
Elle a tourné et fonctionné mais j'ai un message d'erreur
Erreur d'exécution '9':
L'indice n'appartient pas à la sélection
et la ligne
wbb.Sheets(nomf).Range(celb).Value = wbs.Sheets(nomf).Range(cels).Value
est en surbrillance jaune
Tu as mis la macro dans le ficher 2017 (moi, je l'avais mis dans 2016) ce qui change le "ActiveWorkBook"
Bref : Les G7 de 2016 vont se copier dans les G3 de 2017, c'est bien ça ?
Donc il te faut modifier un peu (en laissant la fonction FeuilleExiste bien sûr
Cdlmnt
Bref : Les G7 de 2016 vont se copier dans les G3 de 2017, c'est bien ça ?
Donc il te faut modifier un peu (en laissant la fonction FeuilleExiste bien sûr
Public Sub OK() Dim wbs As Workbook, wbb As Workbook Dim nuf As Long, nbf As Long, nomf As String Set wbs = Workbooks(WS) Set wbb = Workbooks(wb) With ActiveWorkbook nbf = .Sheets.Count For nuf = 1 To nbf nomf = .Sheets(nuf).Name If FeuilleExiste(wbs, nomf) Then .Sheets(nomf).Range(celb).Value = wbs.Sheets(nomf).Range(cels).Value End If Next nuf End With End Sub
Cdlmnt