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

[ThoWmas31]

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 :

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

 

[DoubleZero]

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 ?

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

 

[ThoWmas31]

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

Bonjour, ThoWmas31, le Forum,



Comme ceci ?

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 :

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 :

 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 ?

 

[DoubleZero]

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

Re-bonjour,

Dans ce cas, comme cela ?

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