Macro condition
Popey301
Messages postés
2
Statut
Membre
-
Mike-31 Messages postés 18405 Date d'inscription Statut Contributeur Dernière intervention -
Mike-31 Messages postés 18405 Date d'inscription Statut Contributeur Dernière intervention -
Bonjour,
je suis en train d'élaborer une macro copier/coller avec condition. J'ai réussi à élaborer le copier/coller avec une condition mais qui ne correspond pas au résultat final attendu.
Voici ma macro : Cette macro copie les données d'un tableau de la feuille 1 à la feuille 2, en prenant sélectionnant les lignes dont la cellule de la colonne 2 contient un "1". Par contre, moi je souhaite faire cela sur une plge. C'est à dire copier les lignes dont les chiffres de la colonne 2 sont compris entre 1 et 100.
Sub TransfertDonnees()
'
Dim Cellule As Range
Dim PremiereAdresse As String
Dim LigneDest As Long
'
Sheets("Feuil1").Select
Columns(2).Select
LigneDest = Sheets("Feuil2").Range("A65536").End(xlUp).Row + 1
Set Cellule = Selection.Inf("1")
If Not Cellule Is Nothing Then
PremiereAdresse = Cellule.Address
Do
Cellule.EntireRow.Copy Sheets("Feuil2").Cells(LigneDest, 1)
LigneDest = LigneDest + 1
Set Cellule = Selection.FindNext(Cellule)
Loop Until Cellule.Address = PremiereAdresse
End If
End Sub
Je n'arrive pas à faire évoluer ma macro dans ce sens. Merci pour votre aide.
je suis en train d'élaborer une macro copier/coller avec condition. J'ai réussi à élaborer le copier/coller avec une condition mais qui ne correspond pas au résultat final attendu.
Voici ma macro : Cette macro copie les données d'un tableau de la feuille 1 à la feuille 2, en prenant sélectionnant les lignes dont la cellule de la colonne 2 contient un "1". Par contre, moi je souhaite faire cela sur une plge. C'est à dire copier les lignes dont les chiffres de la colonne 2 sont compris entre 1 et 100.
Sub TransfertDonnees()
'
Dim Cellule As Range
Dim PremiereAdresse As String
Dim LigneDest As Long
'
Sheets("Feuil1").Select
Columns(2).Select
LigneDest = Sheets("Feuil2").Range("A65536").End(xlUp).Row + 1
Set Cellule = Selection.Inf("1")
If Not Cellule Is Nothing Then
PremiereAdresse = Cellule.Address
Do
Cellule.EntireRow.Copy Sheets("Feuil2").Cells(LigneDest, 1)
LigneDest = LigneDest + 1
Set Cellule = Selection.FindNext(Cellule)
Loop Until Cellule.Address = PremiereAdresse
End If
End Sub
Je n'arrive pas à faire évoluer ma macro dans ce sens. Merci pour votre aide.
4 réponses
-
Salut,
Testes cette macros que j'ai adapté pour un transfert de données feuille1 pour des valeurs comprise entre 1 et 100 en collé à la suite sur la feuille2
Sub TransfertDonnees()
'
Dim Lig As Long
Dim LigFinA As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long
Dim LigFin As Long
Sheets("Feuil2").Activate
Col = "B"
LigFin = Range("A65536").End(xlUp).Row + 1
NumLig = 1
With Sheets("Feuil1")
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 1 To NbrLig
If .Cells(Lig, Col).Value >= 1 Then
If .Cells(Lig, Col).Value <= 100 Then
.Cells(Lig, Col).EntireRow.Copy
NumLig = NumLig + 1
Cells(LigFin, 1).Select
LigFin = LigFin + 1
ActiveSheet.Paste
End If
End If
Next
End With
Application.CutCopyMode = False
MsgBox ("TRANSFERT EFFECTUE")
End Sub
A+
Mike-31
Un problème sans solution est un problème mal posé (Einstein)-
Bonjour,
Merci pour l'intérêt porté à ma demande.
Je n'arrive pas à applique ceci sur mon fichier. J'ai l'impression qu'il reste sur la feuille 2 sur laquelle, il fait des copiers/coller de lignes mais ne se base pas sur les données de la feuille 1.
Mon besoin est d'utiliser les données de la feuille 1 et copier/coller la ligne sur la feuille 2 en fonction du contenu de la colonne B (copier/collers si la valeur dans la cellule est comprise entre 1 et 100).
Exemple de données sur la feuille 1 (feuille 2 initialement vide) :
Colonne A Colonne B Colonne C
Heure1... 100 Texte.....
Heure2... 20 Texte.....
Heure 3... 200 Texte....
Dans cet exemple, l'idée est de retrouver sur ma feuille 2 uniquement les lignes avec des données comprises entre 1 et 100, soit les lignes 1 et 2.
-
-
Re,
Rapidement j'ai monté un exemple à récupérer avec le lien ci-dessous, j'ai modifié le code qui efface la feuille 2 avant de transférer les données. Si c'est ce que tu cherches, en fin d'après midi je reverrais le code pour le simplifier
https://www.cjoint.com/?kioDdKbLh4
A+
Mike-31
Un problème sans solution est un problème mal posé (Einstein) -
Re,
Merci beaucoup pour ce travail...c'est exactement ce que je cherchais....
Impeccable, je l'ai appliqué sur mon support en adaptant quelques bricoles (noms de feuilles, emplacement de cellules)...
Thanks -
Re,
Il est possible d'alléger un peu le code,
Si le code te convient, n'oublies pas de mettre ton statut en résolu
Sub TransfertDonnees()
'
Dim Lig As Long
Dim LigFinA As Long
Dim Col As String
Dim NbrLig As Long
Dim NumLig As Long
Dim LigFin As Long
[Feuil2].Activate
LigFin = [A65536].End(xlUp).Select
Range(activecell(), [C2]).ClearContents
Col = "B"
LigFin = [A2].Row + 1
NumLig = 1
With [Feuil1]
NbrLig = .Cells(65536, Col).End(xlUp).Row
For Lig = 1 To NbrLig
If .Cells(Lig, Col).Value >= 1 Then
If .Cells(Lig, Col).Value <= 100 Then
.Cells(Lig, Col).EntireRow.Copy
NumLig = NumLig + 1
Cells(LigFin, 1).Select
LigFin = LigFin + 1
ActiveSheet.Paste
End If
End If
Next
End With
Application.CutCopyMode = False
MsgBox ("TRANSFERT EFFECTUE")
End Sub
A+
Mike-31
Un problème sans solution est un problème mal posé (Einstein)
