Copier coller des valeurs d'un fichier à un autre
Bonjour, j’ai 2 fichiers (cl2 et cl1). La feuille (a) du fichier 2 contient 2 colonnes. Je souhaiterai copier coller les valeurs de ces 2 colonnes dans le fichier 1 feuille (bf) seulement si groupe = a.
J’ai essayé le code suivant mais ça ne fonctionne pas
Sub Macro1()
Dim Fichier1
Fichier1 = Application.GetOpenFilename("Excel (*.xlsx), *.xlsx", , "cl2", , False)
If Fichier1 = False Then Exit Sub
Application.ScreenUpdating = False
With Workbooks.Open(Fichier1)
With Worksheets("a")
nbligne = .Range("a" & Rows.Count).End(xlUp).Row
For i = 2 To nbligne
groupe = .Cells(i, 2).Value
If groupe = "a" Then
nbligne2 = Range("a" & Rows.Count).End(xlUp).Row + 1
nbligne3 = Range("b" & Rows.Count).End(xlUp).Row + 1
Cells(nbligne2, 1) = .Cells(i, 1).Value
Cells(nbligne3, 2) = .Cells(i, 2).Value
End If
Next
End With
End With
End Sub
Merci.
Salut,
Dans le fichier ci-joint, un code qui répond à ton besoin, à condition que le fichier cl2 soit ouvert au moment où tu lances le code. Si ce fichier-cible doit être ouvert par le code, merci de m'indiquer s'il se trouve au même chemin que le fichier cl1 ou à un autre endroit. Si c'est ce deuxième cas, il se trouve à une adresse fixe ou tu veux pouvoir l'ouvrir par une fenêtre de dialogue, comme ça semble être le cas avec ton code à toi ?
Sub Report()
Dim i As Integer, Derlig As Integer
Application.ScreenUpdating = False
Windows("cl2.xlsx").Activate
Sheets("a").Activate
Derlig = Range("A" & Rows.Count).End(xlUp).Row
Range("A2:B" & Derlig).Copy
ThisWorkbook.Activate
Range("A2").PasteSpecial
Application.CutCopyMode = False
For i = Derlig To 2 Step -1
If Range("B" & i) <> "a" Then Range("A" & i & ":B" & i).Delete
Next i
Range("A" & Derlig + 1).Select
End SubCordialement.
Merci beaucoup Yvouille pour votre aide. Votre code marche parfaitement. Je l'ai juste adapté à mon fichier dont lequel les colonnes ne sont pas suivi col a et col c.
Sub Report()
Dim i As Integer, Derlig As Integer
Dim Fichier1
Fichier1 = Application.GetOpenFilename("Excel (*.xlsx), *.xlsx", , "cl2", , False)
If Fichier1 = False Then Exit Sub
Application.ScreenUpdating = False
With Workbooks.Open(Fichier1)
Derlig = Range("A" & Rows.Count).End(xlUp).Row
ThisWorkbook.Sheets("bf").Range("A2:a" & Derlig) = .Sheets("a").Range("a2", .Sheets("a").Range("b2").End(xlDown)).Value
ThisWorkbook.Sheets("bf").Range("b2:b" & Derlig) = .Sheets("a").Range("c2", .Sheets("a").Range("c2").End(xlDown)).Value
.Close
For i = Derlig To 2 Step -1
If Range("b" & i) <> "a" Then Range("A" & i & ":b" & i).Delete
Next i
Range("A" & Derlig + 1).Select
End With
End Sub