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

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

  • GESTION - POTS.xlsm
    318.2 KB · Affichages: 10
  • Prix de revient.xlsm
    371.5 KB · Affichages: 7
Trier par date Trier par votes
Q

Quicksland

XLDnaute Occasionnel
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 :rolleyes:

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
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
Oups! C'est comme à l'école : quand tu lis mal les consignes, t'as une gamelle ! 😅
Il suffit de remplacer
VB: 
Sheets(F.Name).Range("N4:C" & NL).PasteSpecial xlPasteValues
par
Sheets(F.Name).Range("C4:C" & DL).PasteSpecial xlPasteValues
 

Pièces jointes

  • Prix de revient (V2).xlsm
    366.3 KB · Affichages: 3
Vote positif 0 Vote négatif
Q

Quicksland

XLDnaute Occasionnel
Bonjour @sylvanu ;)

Je reviens vers toi ...

Apres modification du fichier les données ont changé :rolleyes:

"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

  • GESTION - POTS.xlsm
    311.4 KB · Affichages: 1
  • PRIX DE REVIENT.xlsm
    676.3 KB · Affichages: 2
Vote positif 0 Vote négatif
Q

Quicksland

XLDnaute Occasionnel
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
Q

Quicksland

XLDnaute Occasionnel
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 :rolleyes:
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
sylvanu

sylvanu

XLDnaute Barbatruc
Supporter XLD
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

  • PRIX DE REVIENT.xlsm
    744.4 KB · Affichages: 4
Vote positif 0 Vote négatif
Q

Quicksland

XLDnaute Occasionnel
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 :rolleyes:
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

M
  • Résolu(e)
Microsoft 365 Problème de formule
Réponses
11
Affichages
433
Marvin57
M
N
  • Question
XL 2016 Récupération de lignes dans un autre fichier excel
Réponses
4
Affichages
288
ninieg
N
M
  • Question
Autres Création d'un fichier vba
Réponses
3
Affichages
370
sylvanu
sylvanu
gsx-air
  • Question
Microsoft 365 Copier un fichier dans l'explorer vers le presse-papier
Réponses
0
Affichages
187
gsx-air
gsx-air
Z
  • Question
XL 2016 Macro pour copier plusieurs cellules vers un fichier :(
Réponses
3
Affichages
234
zendb
Z
Q
  • Question
XL 2019 vba pour effacer résultat cellules de plusieurs fichiers a partir d'un fichier distant
Réponses
6
Affichages
144
Phil69970
Phil69970
S
  • Résolu(e)
Microsoft 365 [RESOLU] Excel : Calcul de prix en fonction d'un type
Réponses
4
Affichages
133
JHA
J
Q
  • Question
XL 2019 incrémentation fichier a partir d'un autre fichier avec menu déroulant
Réponses
2
Affichages
645
TooFatBoy
TooFatBoy
S
  • Question
Autres Comment envoyer directement un fichier Excel, vers périphérique Bluetooth, après enregistrement?
Réponses
3
Affichages
298
patricktoulon
patricktoulon
edgy63
  • Question
Microsoft 365 Remplir cellules à partir de plusieurs fichiers Excel d'un dossier
2
Réponses
17
Affichages
403
alexga78
A

Membres actuellement en ligne

4 membres et 69 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 485
Messages
2 110 101
Membres
110 663
dernier inscrit
ToussaintBug