Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Microsoft 365 Cpier/coller en VBA

A-F

XLDnaute Nouveau
Bonjour tout le monde,
Je débute en VBA et j'ai besoin votre aide.
Je dois créer une base de donnée à partir de plusieurs tables.
J'ai besoin de copier certains colonnes de ces tables dans un fichier Excel.
j'ai réussit à faire cela mais sans vérification que je prendre le bon info/chiffre et le copier dans la ligne concernée. je copie la colonne en entier donc si dans la fichier de base, mais colonne sont pas dans le même ordre que mon fichier sortie je vais pas avoir la bon info.
j'ai besoin de vérifier que colonne A de fichier de base soit égale à la colonne A de fichier sorite et copier l'info dans le même ligne. Mais je ne sais pas comment je peux faire cela en boucle pour chaque ligne.

Merci par avance pour votre aide !!

Voici le code que j'ai fait.

VB:
sub test()
Workbooks("OLL.xlsx").Activate
    i = 3
 
                     For Each C In Workbooks("OLL.xlsx").Worksheets("EPCI").Range("C" & i & ":C" & FinalRow) 'Le code dep
                   
               
                         If C.Value = "85" Then ' si la valeure de cellule = 85
                           
                                 
                                   Workbooks("OLL.xlsx").Worksheets("EPCI").Range("G" & i & ":H" & i).Copy 'loyer 2
                   
                                   'Trouver la dernier ligne
                                   Workbooks("EPCI.xlsx").Activate
                                   NextRow = Cells(Rows.Count, 63).End(xlUp).Row + 1
                                 
                                   'Paste
                                   Cells(NextRow, 63).Select
                                   ActiveCell.PasteSpecial Paste:=xlPasteValues
                            'End If
                        End If
                        i = i + 1
                    Next
                   
end sub

ca c'est le code que j'ai fait en essayant de vérifier le nom EPCI qui ne marche pas !
VB:
Sub Chek_EPCI()

Dim C As Range
    Dim nb As Integer, i As Long, NextRow As Integer, FinalRow As Long
    Dim Classeur As Workbook
    Dim LaFeuille As Worksheet
    Dim FichierEx As String
    Dim Chemin As String

Workbooks("OLL.xlsx").Activate
FinalRow = Cells(Rows.Count, 1).End(xlUp).Row
    i = 3
  
                     For Each C In Workbooks("OLL.xlsx").Worksheets("EPCI").Range("C" & i & ":C" & FinalRow) 'Le code dep
                    
                
                         If C.Value = "85" Then ' si la valeure de cellule = 85
                            'If frmEtudiantDUT.TextBox_Nom = Cells(Target.Row, 1) Then
                             If C.Offset(0, -1).Value = Workbooks("EPCI.xlsx").Worksheets("EPCI").Cells(Target.Row, 1) Then
                            
                                  
                                   Workbooks("OLL.xlsx").Worksheets("EPCI").Range("G" & i & ":H" & i).Copy 'loyer 2
                    
                                   'Trouver la dernier ligne
                                   Workbooks("EPCI.xlsx").Activate
                                   NextRow = Cells(Rows.Count, 63).End(xlUp).Row + 1
                                  
                                   'Paste
                                   Cells(NextRow, 63).Select
                                   ActiveCell.PasteSpecial Paste:=xlPasteValues
                            End If
                        End If
                        i = i + 1
                    Next
            
            
End Sub
 

Pièces jointes

  • Copier1.xlsx
    11.3 KB · Affichages: 4
Dernière édition:

WTF

XLDnaute Impliqué
Bonjour A-F,
Pourquoi passer par du VBA alors que tu peux le faire par PowerQwery ?
Exemple en PJ.
si tu ajoutes une ligne sur ton tableau de données, tu cliques sur Données/actualiser et ton onglet de restitution se met à jour.
 

Pièces jointes

  • Copier1.xlsx
    21.7 KB · Affichages: 5

A-F

XLDnaute Nouveau
Bonjour A-F,
Pourquoi passer par du VBA alors que tu peux le faire par PowerQwery ?
Exemple en PJ.
si tu ajoutes une ligne sur ton tableau de données, tu cliques sur Données/actualiser et ton onglet de restitution se met à jour.
Merci pour ta réponse,
Mais je dois passer par VBA.
Je ne cherche pas à mettre à jour mes données mes simplement copier les colonne que j'ai besoin dans un autre fichier.
 

cp4

XLDnaute Barbatruc
Bonjour @WTF , @A-F ,

Si j'ai bien compris, mets ce code dans un module standard et enregistre ton fichier en xlsm.
puis exécute le code
VB:
Option Explicit

Sub copier_coller()
   Dim Rng As Range, dl As Long, Fd As Worksheet, Fs As Worksheet, i As Long, j As Byte, n As Long
   Set Fd = ThisWorkbook.Sheets("base de depart")
   Set Fs = ThisWorkbook.Sheets("sortie")
   Set Rng = Fd.Range("a1").CurrentRegion
   dl = Rng.Rows.Count
   Fs.Cells.Clear
   '---------------------------------
   For i = 1 To 2
      Fs.Cells(i, 1) = Fd.Cells(i, 1)
      Fs.Cells(i, 2) = Fd.Cells(i, 2)
      Fs.Cells(i, 3) = Fd.Cells(i, 7)
      Fs.Cells(i, 4) = Fd.Cells(i, 8)
   Next
   '--------------------------------
   n = 3
   For i = 3 To dl
      If Fd.Cells(i, 3).Value = 85 Then
         Fs.Cells(n, 1) = Fd.Cells(i, 1)
         Fs.Cells(n, 2) = Fd.Cells(i, 2)
         Fs.Cells(n, 3) = Fd.Cells(i, 7)
         Fs.Cells(n, 4) = Fd.Cells(i, 8)
         n = n + 1
      End If
   Next i
End Sub
 

cp4

XLDnaute Barbatruc
Merci pour ta réponse,
Mais je dois passer par VBA.
Je ne cherche pas à mettre à jour mes données mes simplement copier les colonne que j'ai besoin dans un autre fichier.
Là, c'est sur le même fichier modifie comme ceci, mais le fichier de destination doit être ouvert au préalable.
au lieu de
Code:
Set Fs = ThisWorkbook.Sheets("sortie")
Tu remplaces ThisWorkBook par ton classeur
Code:
Set Fs = Workbooks("Nom de ton classeur").Sheets("sortie")
 

A-F

XLDnaute Nouveau
Bonjour cp4,
Merci pour ta réponse!
Ton code il marche ( même si je ne le comprend pas vraiment ))
Mais il me semble que le code copie pas que les colonne avec les chiffres mais aussi les deux premier colonnes avec le code EPCI et libellé EPCI aussi. ce n'est pas vraiment ce que je veux car je dois faire le traitement sur plusieurs table et il ne peut pas à chaque fois changer l'ordre des code et libellées.

J'ai aussi une question, comment je peut indiquer l'endroit où il doit coller les chiffre (la colonne, et même ligne que code EPCI) ?
car encore une fois je vais copier coller plusieurs colonne et il faut pas que j'écrase ce qui est déjà coller. soit je doit prendre la dernier colonne non vide soit donner une colonne ( par exemple celle(i, 64)).

Merci par avance pour ta réponse !
 

cp4

XLDnaute Barbatruc
Re,
@A-F : Alors, Je n'ai pas vraiment compris ta demande. Mon code ne fait pas du copier/coller mais il affecte les valeurs des cellules du fichier source vers le fichier de destination. Avec comme condition de ne prendre que les lignes dont la valeur en colonne 3 est égale à 85.

Pour connaitre la dernière colonne non vide de la ligne 1
VB:
dercol=Cells(1, Columns.Count).End(xlToLeft).Column

J'ai mis quelques commentaires pour comprendre le code. Utilise le mode pas à pas pour bien comprendre le code avec la touche F8.
Code:
Option Explicit

Sub copier_coller()
   Dim Rng As Range, dl As Long, Fd As Worksheet, Fs As Worksheet, i As Long, j As Byte, n As Long
   Set Fd = ThisWorkbook.Sheets("base de depart")
   Set Fs = ThisWorkbook.Sheets("sortie")'*** à adapter '
   Set Rng = Fd.Range("a1").CurrentRegion
   dl = Rng.Rows.Count
  
   Fs.Cells.Clear 'on vide la feuille de destination
   '----------on met les titres de colonnes, 2 lignes -----------------------
   For i = 1 To 2
      Fs.Cells(i, 1) = Fd.Cells(i, 1)
      Fs.Cells(i, 2) = Fd.Cells(i, 2)
      Fs.Cells(i, 3) = Fd.Cells(i, 7)
      Fs.Cells(i, 4) = Fd.Cells(i, 8)
   Next
   '--------------------------------
   n = 3 'à partir de la 3ème ligne
   For i = 3 To dl 'boucle jusqu'à la dernière ligne non vide
      If Fd.Cells(i, 3).Value = 85 Then 'si valeur colonne 3 égale 85, alors on récupère les données
         Fs.Cells(n, 1) = Fd.Cells(i, 1)
         Fs.Cells(n, 2) = Fd.Cells(i, 2)
         Fs.Cells(n, 3) = Fd.Cells(i, 7)
         Fs.Cells(n, 4) = Fd.Cells(i, 8)
         n = n + 1 '+1 pour passer à la ligne suivante
      End If
   Next i
Set Fd = Nothing: Set Fs = Nothing: Set Rng = Nothing 'on libère de la mémoire
End Sub

Bonne soirée
 

A-F

XLDnaute Nouveau
Merci beaucoup , je vais essayer de l'adapter à ce que je veux ^^
 

Discussions similaires

Réponses
2
Affichages
307
  • Question
Microsoft 365 Code VBA
Réponses
10
Affichages
718
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…