Copier et coller des lignes selon la valeur d'une cellule
Fermé
senecartour
Messages postés
325
Date d'inscription
dimanche 12 mai 2013
Statut
Membre
Dernière intervention
29 octobre 2020
-
Modifié par senecartour le 1/01/2015 à 00:25
Mike-31 Messages postés 18318 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 26 avril 2024 - 1 janv. 2015 à 01:06
Mike-31 Messages postés 18318 Date d'inscription dimanche 17 février 2008 Statut Contributeur Dernière intervention 26 avril 2024 - 1 janv. 2015 à 01:06
A voir également:
- Copier et coller des lignes selon la valeur d'une cellule
- Aller à la ligne dans une cellule excel - Guide
- Copier une vidéo youtube - Guide
- Copier coller pdf - Guide
- Le fichier contient le nombre de voyageurs dans 3 gares. dans la cellule b5, saisissez une formule qui calcule le total et se met à jour si on change une valeur du tableau. quel total obtenez-vous ? quelle formule avez-vous saisie ? ✓ - Forum Excel
- Symbole coeur copier-coller ✓ - Forum Réseaux sociaux
1 réponse
Mike-31
Messages postés
18318
Date d'inscription
dimanche 17 février 2008
Statut
Contributeur
Dernière intervention
26 avril 2024
5 076
Modifié par Mike-31 le 1/01/2015 à 01:07
Modifié par Mike-31 le 1/01/2015 à 01:07
Bonjour,
Colle ce code dans un module et associe le à un bouton, les valeurs B de la colonne A seront collées sur la feuille nommée Feuil2 et les valeurs A sur la feuille Feuil3
Sub Transfert()
Dim LigFin As Long
LigFin = [A65000].End(xlUp).Row
On Error Resume Next
Application.ScreenUpdating = False
Sheets("Feuil2").Cells.ClearContents
Sheets("Feuil3").Cells.ClearContents
Sheets("Feuil1").Range([A1], ["J"] & LigFin).AutoFilter Field:=1, Criteria1:="B"
If ActiveCell.Row = 1 Then
Exit Sub
Else
Range([A1], ["J"] & LigFin).Copy
Sheets("Feuil2").Select
[A1].PasteSpecial Paste:=xlPasteValues
[A2].Select
End If
Sheets("Feuil1").Select
Sheets("Feuil1").Range([A1], ["J"] & LigFin).AutoFilter Field:=1, Criteria1:="A"
If ActiveCell.Row = 1 Then
Exit Sub
Else
Sheets("Feuil3").Cells.ClearContents
Range([A1], ["J"] & LigFin).Copy
Sheets("Feuil3").Select
[A1].PasteSpecial Paste:=xlPasteValues
[A2].Select
End If
Sheets("Feuil1").Select
Application.CutCopyMode = False
[A1:G1].AutoFilter
Application.ScreenUpdating = True
MsgBox "Les données ont été ventilées", , "transfert terminé"
End Sub
A+
Mike-31
Une période d'échec est un moment rêvé pour semer les graines du savoir.
Colle ce code dans un module et associe le à un bouton, les valeurs B de la colonne A seront collées sur la feuille nommée Feuil2 et les valeurs A sur la feuille Feuil3
Sub Transfert()
Dim LigFin As Long
LigFin = [A65000].End(xlUp).Row
On Error Resume Next
Application.ScreenUpdating = False
Sheets("Feuil2").Cells.ClearContents
Sheets("Feuil3").Cells.ClearContents
Sheets("Feuil1").Range([A1], ["J"] & LigFin).AutoFilter Field:=1, Criteria1:="B"
If ActiveCell.Row = 1 Then
Exit Sub
Else
Range([A1], ["J"] & LigFin).Copy
Sheets("Feuil2").Select
[A1].PasteSpecial Paste:=xlPasteValues
[A2].Select
End If
Sheets("Feuil1").Select
Sheets("Feuil1").Range([A1], ["J"] & LigFin).AutoFilter Field:=1, Criteria1:="A"
If ActiveCell.Row = 1 Then
Exit Sub
Else
Sheets("Feuil3").Cells.ClearContents
Range([A1], ["J"] & LigFin).Copy
Sheets("Feuil3").Select
[A1].PasteSpecial Paste:=xlPasteValues
[A2].Select
End If
Sheets("Feuil1").Select
Application.CutCopyMode = False
[A1:G1].AutoFilter
Application.ScreenUpdating = True
MsgBox "Les données ont été ventilées", , "transfert terminé"
End Sub
A+
Mike-31
Une période d'échec est un moment rêvé pour semer les graines du savoir.
