XL 2013 Si cellule condition, alors copie colonne sur autre feuille

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

ThoWmas31

XLDnaute Nouveau
Bonjour tout le monde,

J'ai un petit soucis sur une macro que je souhaite réalisé, en PJ mon fichier ( ca serra plus simple pour comprendre )

Je cherche à copier les valeurs (des colonnes I à N) dans la feuille TOP si colonne H = "T;" et si colonne H = "B;"

j'ai essayé avec ce code la mais je n'arrive pas à l'adapter a mes besoins :

Code:
Sub cpaste()
    
    ActiveSheet.Name = "CAO"
    Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "TOP"
    Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "BOT"
    Sheets("CAO").Activate
    
    
    Dim myrange As Range
    Sheets("CAO").Select
    Set myrange = Sheets("CAO").Range("H1", Range("H" & Rows.Count).End(xlUp))
    For Each cell In myrange
        If cell.Value = "T;" Then
            lr = Sheets("TOP").Range("H" & Rows.Count).End(xlUp).Row
            cell.EntireRow.Copy Destination:=Sheets("TOP").Range("A" & lr + 1)
        End If
    Next cell
End Sub
 

Pièces jointes

Re : Si cellule condition, alors copie colonne sur autre feuille

Bonjour, ThoWmas31, le Forum,

...copier les valeurs (des colonnes I à N) dans la feuille TOP si colonne H = "T;" et si colonne H = "B;"...

Comme ceci ?

Code:
Sub Dupliquer_selon_valeur()
    Dim c As Range
    For Each c In Sheets("CAO").Columns(8).SpecialCells(xlCellTypeConstants, 23)
        If c.Value = "B;" Or c.Value = "T;" Then Sheets("TOP").Range("a" & Rows.Count).End(xlUp)(2).Resize(, 6).Value = c.Offset(, 1).Resize(, 6).Value
    Next
End Sub

A bientôt 🙂
 
Re : Si cellule condition, alors copie colonne sur autre feuille

Bonjour, ThoWmas31, le Forum,



Comme ceci ?

Code:
Sub Dupliquer_selon_valeur()
    Dim c As Range
    For Each c In Sheets("CAO").Columns(8).SpecialCells(xlCellTypeConstants, 23)
        If c.Value = "B;" Or c.Value = "T;" Then Sheets("TOP").Range("a" & Rows.Count).End(xlUp)(2).Resize(, 6).Value = c.Offset(, 1).Resize(, 6).Value
    Next
End Sub

A bientôt 🙂

Je me suis mal exprimé, ou du moins j'ai oublier de précisé

Si Colonne H = T; mettre dans la feuille TOP
Si Colonne H = B; mettre dans la feuille BOT

pour la creation des feuilles j'ai mis cette formule :

Code:
ActiveSheet.Name = "CAO"
    Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "TOP"
    Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "BOT"
    Sheets("CAO").Activate


edit j'ai modifier ton code pour avoir le résultat presque attendu :

Code:
 Dim c As Range
    For Each c In Sheets("CAO").Columns(8).SpecialCells(xlCellTypeConstants, 23)
        If c.Value = "T;" Then Sheets("TOP").Range("a" & Rows.Count).End(xlUp)(2).Resize(, 6).Value = c.Offset(, 1).Resize(, 6).Value
        If c.Value = "B;" Then Sheets("BOT").Range("a" & Rows.Count).End(xlUp)(2).Resize(, 6).Value = c.Offset(, 1).Resize(, 6).Value
    Next

Par contre il commence a la ligne 2 , comment le faire commencer a la ligne 1 ?
 
Dernière édition:
Re : Si cellule condition, alors copie colonne sur autre feuille

Re-bonjour,

Dans ce cas, comme cela ?

Code:
Option Explicit
Sub Dupliquer_selon_valeur_v2()
    Dim c As Range, o As Object
    Application.ScreenUpdating = False
    For Each c In Sheets("CAO").Columns(8).SpecialCells(xlCellTypeConstants, 23)
        If c.Value = "T;" Then Sheets("TOP").Range("a" & Rows.Count).End(xlUp)(2).Resize(, 6).Value = c.Offset(, 1).Resize(, 6).Value
        If c.Value = "B;" Then Sheets("BOT").Range("a" & Rows.Count).End(xlUp)(2).Resize(, 6).Value = c.Offset(, 1).Resize(, 6).Value
    Next
    For Each o In Sheets(Array("TOP", "BOT"))
        If o.Application.WorksheetFunction.CountA(o.Rows("1:1")) = 0 Then o.Rows("1:1").Delete Shift:=xlUp
    Next
    Application.ScreenUpdating = True
End Sub

A bientôt 🙂
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
1
Affichages
520
Retour