XL 2019 Récupération valeurs d'un fichier vers un autre vba

Créer une discussion
Répondre

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

S'inscrire
Q

Quicksland

XLDnaute Occasionnel
Bonjour le forum 😉

Je souhaiterai récupérer les valeurs " fichier pot " toute la colonne a partir "E4" vers "E4" du fichier " prix de revient "

et également pour toute la colonne "N4 " du " fichier pot " vers "C4" du fichier " prix de revient "

Je vous remercie d'avance pour les réponses
 

Pièces jointes

Trier par date Trier par votes
sylvanu à dit:
Bonsoir Quicksland,
Un essai en PJ à tester.
La macro à lancer est "Importer"
A noter qu'il y aura surement un problème de février année bissextile vers année non bissextile.
Cliquez pour agrandir...
Bonsoir @sylvanu 😉

Merci pour ta réponse 👍

Il y a un petit soucis quand même 🙄

Quicksland à dit:
"N4 " du " fichier pot " vers "C4" du fichier " prix de revient "
Cliquez pour agrandir...

et non " N4" vers " N4 " 😉

Merci pour ton aide 👍
 
Vote positif 0 Vote négatif
Bonjour @sylvanu 😉

Je reviens vers toi ...

Apres modification du fichier les données ont changé 🙄

"GESTION-POTS " vers "PRIX DE REVIENT"

Toute la colonne de :

"C4" vers "C4"
"E4" vers "E4"
"F4" vers "F4"
"G4" vers "G4"
"H4" vers "H4"

J'ai réduit le fichier a 6 mois car trop volumineux en PJ

Merci pour ton aide 😉
 

Pièces jointes

Vote positif 0 Vote négatif
Bonsoir,
Il vous suffit d'adapter le code.
Pour transférer d'une colonne à une autre il suffit de faire par ex de C4 vers C4 :
VB: 
DL = Sheets(F.Name).Range("C65500").End(xlUp).Row - 1
.Range("C4:C" & DL).Copy
Et recopier ces deux lignes pour vos 5 transferts.
 
Vote positif 0 Vote négatif
sylvanu à dit:
Bonsoir,
Il vous suffit d'adapter le code.
Pour transférer d'une colonne à une autre il suffit de faire par ex de C4 vers C4 :
VB: 
DL = Sheets(F.Name).Range("C65500").End(xlUp).Row - 1
.Range("C4:C" & DL).Copy
Et recopier ces deux lignes pour vos 5 transferts.
Cliquez pour agrandir...
Re,
VB: 
DL = Sheets(F.Name).Range("E65500").End(xlUp).Row - 1
                .Range("C4:C" & DL).Copy
                Sheets(F.Name).Range("C4:C" & DL).PasteSpecial xlPasteValues

Cela donne ça alors ?
 
Vote positif 0 Vote négatif
sylvanu à dit:
Oui, et vous répétez pour les 5 colonnes.
Cliquez pour agrandir...
Ok 😉 !

C'est bien ce que j'avais compris mais pourtant cela ne fonctionne pas 🙄
VB: 
Private Sub CommandButton2_Click()

    Application.ScreenUpdating = False
    NomFichier = "GESTION - POTS.xlsm"
    FichierCourant = ThisWorkbook.Name
    Workbooks.Open ThisWorkbook.Path & "\" & NomFichier
    Workbooks(FichierCourant).Activate
    For Each F In Worksheets
        If Sheets(F.Name).[E2] = "Coût solide / Prestation" Then
            With Workbooks(NomFichier).Sheets(F.Name)
                DL = Sheets(F.Name).Range("E65500").End(xlUp).Row - 1
                .Range("C4:C" & DL).Copy
                Sheets(F.Name).Range("C4:C" & DL).PasteSpecial xlPasteValues
                .Range("E4:E" & DL).Copy
                Sheets(F.Name).Range("E4:E" & DL).PasteSpecial xlPasteValues
                .Range("F4:F" & DL).Copy
                Sheets(F.Name).Range("F4:F" & DL).PasteSpecial xlPasteValue
                 .Range("G4:G" & DL).Copy
                Sheets(F.Name).Range("G4:G" & DL).PasteSpecial xlPasteValue
                .Range("H4:H" & DL).Copy
                Sheets(F.Name).Range("H4:H" & DL).PasteSpecial xlPasteValue
        
            End With
        End If
    Next F
    Application.CutCopyMode = False
    Workbooks(NomFichier).Close Savechanges:=False
End Sub

Merci pour ton aide 👍
 
Vote positif 0 Vote négatif
Bonsoir,
Dans l'ordre,
1- Par sécurité je vérifier que sur la feuille en E2 il y avait "Coût solide / Prestation" .
maintenant ce n'est plus le cas, donc ça ne pouvait pas marcher. J'ai remplacé par "Format".
2- Comme les colonnes sont vides, DL vaut 2, et avec C4:C2 ça ne marche pas.
J'ai rajouté :
VB: 
If DL < 4 Then DL = 4
3- C'est inutile de recopier le code sur toutes les pages, c'est source d'erreur en cas de maintenance, on est sur d'oublier une page.
Donc dans chaque page j'ai mis :
Code: 
Private Sub CommandButton2_Click()
    Importer
End Sub
Et en macro classique :
Code: 
Sub Importer()
    Application.ScreenUpdating = False
    NomFichier = "GESTION - POTS.xlsm"
    FichierCourant = ThisWorkbook.Name
    Workbooks.Open ThisWorkbook.Path & "\" & NomFichier
    Workbooks(FichierCourant).Activate
    For Each F In Worksheets
        If Sheets(F.Name).[E2] = "Format" Then
            With Workbooks(NomFichier).Sheets(F.Name)
                DL = Sheets(F.Name).Range("E65500").End(xlUp).Row - 1
                If DL < 4 Then DL = 4
                .Range("C4:C" & DL).Copy
                Sheets(F.Name).Range("C4:C" & DL).PasteSpecial xlPasteValues
                .Range("E4:E" & DL).Copy
                Sheets(F.Name).Range("E4:E" & DL).PasteSpecial xlPasteValues
                .Range("F4:F" & DL).Copy
                Sheets(F.Name).Range("F4:F" & DL).PasteSpecial xlPasteValues
                .Range("G4:G" & DL).Copy
                Sheets(F.Name).Range("G4:G" & DL).PasteSpecial xlPasteValues
                .Range("H4:H" & DL).Copy
                Sheets(F.Name).Range("H4:H" & DL).PasteSpecial xlPasteValues
            End With
        End If
    Next F
    Application.CutCopyMode = False
    Workbooks(NomFichier).Close Savechanges:=False
End Sub
 

Pièces jointes

Vote positif 0 Vote négatif
sylvanu à dit:
Bonsoir,
Dans l'ordre,
1- Par sécurité je vérifier que sur la feuille en E2 il y avait "Coût solide / Prestation" .
maintenant ce n'est plus le cas, donc ça ne pouvait pas marcher. J'ai remplacé par "Format".
2- Comme les colonnes sont vides, DL vaut 2, et avec C4:C2 ça ne marche pas.
J'ai rajouté :
VB: 
If DL < 4 Then DL = 4
3- C'est inutile de recopier le code sur toutes les pages, c'est source d'erreur en cas de maintenance, on est sur d'oublier une page.
Donc dans chaque page j'ai mis :
Code: 
Private Sub CommandButton2_Click()
    Importer
End Sub
Et en macro classique :
Code: 
Sub Importer()
    Application.ScreenUpdating = False
    NomFichier = "GESTION - POTS.xlsm"
    FichierCourant = ThisWorkbook.Name
    Workbooks.Open ThisWorkbook.Path & "\" & NomFichier
    Workbooks(FichierCourant).Activate
    For Each F In Worksheets
        If Sheets(F.Name).[E2] = "Format" Then
            With Workbooks(NomFichier).Sheets(F.Name)
                DL = Sheets(F.Name).Range("E65500").End(xlUp).Row - 1
                If DL < 4 Then DL = 4
                .Range("C4:C" & DL).Copy
                Sheets(F.Name).Range("C4:C" & DL).PasteSpecial xlPasteValues
                .Range("E4:E" & DL).Copy
                Sheets(F.Name).Range("E4:E" & DL).PasteSpecial xlPasteValues
                .Range("F4:F" & DL).Copy
                Sheets(F.Name).Range("F4:F" & DL).PasteSpecial xlPasteValues
                .Range("G4:G" & DL).Copy
                Sheets(F.Name).Range("G4:G" & DL).PasteSpecial xlPasteValues
                .Range("H4:H" & DL).Copy
                Sheets(F.Name).Range("H4:H" & DL).PasteSpecial xlPasteValues
            End With
        End If
    Next F
    Application.CutCopyMode = False
    Workbooks(NomFichier).Close Savechanges:=False
End Sub
Cliquez pour agrandir...
Re bonsoir @sylvanu 😉

Cela fonctionne très bien mais il y a un petit soucis car cela fonctionne juste sur la première ligne 🙄
 
Dernière édition:
Vote positif 0 Vote négatif
Rejoins nos membres "Supporter XLD" et booste ton expérience Excel !
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

M
  • Résolu(e)
Microsoft 365 Problème de formule
Réponses
11
Affichages
499
Marvin57
M
C
  • Question Question
Microsoft 365 Liste déroulante dynamique / dépendante d'un critère ou plus, *sans* VBA ? Une sorte d'Unique à conditions ? + ordre alpha ?
Réponses
8
Affichages
199
JHA
J
T
  • Résolu(e)
Microsoft 365 Exporter les plages nommées vers un nouveau classeur - plage nommée invalide selon VBA
Réponses
2
Affichages
146
tnion
T
D
  • Résolu(e)
Microsoft 365 Récupérer la valeur d'une cellule d'un autre fichier
Réponses
7
Affichages
130
Diane272727
D
A
  • Résolu(e)
Microsoft 365 programme VBA pour "importer" les valeurs de certaines cellules d'une autre feuille appartenant à une ligne que j'identifie par un n°
2
Réponses
27
Affichages
647
arnomorize
A
A
  • Résolu(e)
Microsoft 365 Demande d'aide sur des extractions de lignes
Réponses
7
Affichages
92
agayet
A
O
  • Question Question
XL 2016 transférer les données d'un tableau brut, dans un autre format pour analyse.
Réponses
12
Affichages
258
ORL
O
A
  • Résolu(e)
XL 2019 VBA - Copie données selon 3 critères
Réponses
4
Affichages
331
abouilies
A
N
  • Question Question
XL 2016 Récupération de lignes dans un autre fichier excel
Réponses
4
Affichages
367
ninieg
N
Z
  • Question Question
Microsoft 365 Exporter le visuel d'une cellule vers un fichier PNG
Réponses
4
Affichages
115
patricktoulon
patricktoulon
jcf6464
  • Question Question
Microsoft 365 Contrôle sur nom et prénom d'un classeur a l'autre classeur
Réponses
10
Affichages
237
jcf6464
jcf6464
J
  • Question Question
Microsoft 365 Naviguer dans un tableau pour copier des données dans un modèle et copier l'un derrière l'autre
Réponses
11
Affichages
144
AtTheOne
AtTheOne
Captain NRJ
  • Question Question
XL 2016 Gestion de Fuites d'un Parc de Compteurs
Réponses
6
Affichages
293
Captain NRJ
Captain NRJ
M
  • Question Question
Microsoft 365 Comptabilité : Création d'un fichier automatique d'analyse de comptes
Réponses
2
Affichages
587
Max
M
O
  • Question Question
XL 2013 Recopier automatique des valeurs d'un onglet vers un autre onglet selon critère
Réponses
2
Affichages
550
olivieroma
O
S
  • Résolu(e)
Microsoft 365 [RESOLU] Excel : Calcul de prix en fonction d'un type
Réponses
4
Affichages
271
JHA
J
edgy63
  • Question Question
Microsoft 365 Remplir cellules à partir de plusieurs fichiers Excel d'un dossier
2
Réponses
17
Affichages
598
alexga78
A
Q
  • Question Question
XL 2019 vba pour effacer résultat cellules de plusieurs fichiers a partir d'un fichier distant
Réponses
6
Affichages
222
Phil69970
Phil69970
Y
  • Question Question
XL 2016 Synthétiser tableau de données
Réponses
6
Affichages
220
YOUYOU25
Y
gsx-air
  • Question Question
Microsoft 365 Copier un fichier dans l'explorer vers le presse-papier
Réponses
0
Affichages
277
gsx-air
gsx-air
Retour