Copier d'une feuille à l'autre avec condition

Bonjour

Je débute en VBA et j’ai besoin d’aide svp

J'ai besoin de repérer certaines lignes d'un tableau de données en fonction de la valeur d'une des colonnes (mon critère étant dans la colonne H de la feuille "CRS", de copier une partie des lignes (colonnes H à S) et de les coller dans une autre feuille appeler "Calcul prix " dans la colonne L ligne 278. J’ai monté ce qui suit par contre il ne me copie pas tout et je ne sais pas pourquoi. Quelqu’un peut m’aider svp

Sub CRS16ga60120()

Sheets("CRS").Select

Range("H2").Select

Do While ActiveCell.Value <> ""

If ActiveCell.Value Like "CRS 60 * 120 16GA*" Then

ligne = ActiveCell.Row

Range(Cells(ligne, 8), Cells(ligne, 19)).Copy

Sheets("Calcul prix").Activate

Range("L277").Select

If ActiveCell.Offset(1, 0).Value = "" Then

ActiveCell.Offset(1, 0).Select

ActiveSheet.Paste

Sheets("CRS").Select

ActiveCell.Offset(1, 0).Select

Else

Selection.End(xlDown).Select

ActiveCell.Offset(1, 0).Select

ActiveSheet.Paste

ActiveCell.Offset(1, 0).Select

End If

Else

ActiveCell.Offset(1, 0).Select

End If

Loop

End Sub

Bonsoir Chantal,

sans fichier pour tester... un premier jet à coller, théoriquement, dans "CRS".

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim tTab
'
Set wks = Worksheets("Calcul prix")
'
iRow = Range("H" & Rows.Count).End(xlUp).Row
tTab = Range("H2:H" & iRow)
iLig = 276
'
For x = 1 To UBound(tTab)
    If tTab(x, 1) Like "CRS 60 * 120 16GA*" Then
        iLig = iLig + 1
        Range("H" & x & ":S" & x).Copy Destination:=wks.Range("L" & iLig & ":W" & iLig)
    End If
Next
'
End Sub

Tu me dis quoi demain?

A+

Merci beaucoup je vais essayer cela et je te redonne des nouvelles

C'est génial cela fonctionne à merveille, mais j'aurais une autre petite chose à te demander, c'est-à dire que dans ma colonne H j'ai plusieurs sorte d'item soit CRS 60 * 120 16GA qui doit aller à la ligne 277 dans la feuille calcul prix (comme tu m'a fait) mais j'ai aussi du CRS 48 * 120 13GA qui doit aller à ligne 306 de la feuille calcul prix et ainsi de suite. Peut-on le faire dans une seul macro ? Merci

de m'aider

Bonjour Chantal,

bien matinale, dis donc!

Toujours sans fichier et sans test... 8)

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
Dim wks1 As Worksheet
Dim wks2 As Worksheet
Dim tTab
'
Set wks = Worksheets("Calcul prix")
'
iRow = Range("H" & Rows.Count).End(xlUp).Row
tTab = Range("H2:H" & iRow)
iLig1 = 276
iLig2 = 305
'
For x = 1 To UBound(tTab)
    If tTab(x, 1) Like "CRS 60 * 120 16GA*" Then
        iLig1 = iLig1 + 1
        Range("H" & x & ":S" & x).Copy Destination:=wks.Range("L" & iLig1 & ":W" & iLig1)
    End If
    If tTab(x, 1) Like "CRS 48 * 120 13GA*" Then
        iLig2 = iLig2 + 1
        Range("H" & x & ":S" & x).Copy Destination:=wks.Range("L" & iLig2 & ":W" & iLig2)
    End If
Next
'
End Sub

Bon travail!

A+

Bonjour

J'aimerais que tu m'explique ce tu as fait svp car le calcul ne se fait pas correctement et je pense qu'avec les explications je vais être en mesure de trouver ce qui ne fonctionne pas (meilleur moyen d'apprendre)

Merci encore

Chantal

Bonjour

Voici finalement mon fichier que j'ai beaucoup simplifier pour une question de confidentialité. Le bug c'est qu'il copie la ligne avant de celle qui devrait prendre. J'ai fait des recherches sur la fonction ubound et j'ai beaucoup de difficulté à comprendre, alors c'est pourquoi je fais encore appelle à vous

Merci

Chantal

Bonjour Chantal,

C'est de ma faute! Corrigé!

En fait Ttab qui commence à 1 (logique!) reprend ta colonne H qui, elle, commence à la ligne 2.

Il faut donc indiquer à la macro que les données à pêcher sont affichées en tTab +1!

'
Dim wks As Worksheet
Dim tTab
'
Set wks = Worksheets("Calcul prix")
'
iRow = Range("H" & Rows.Count).End(xlUp).Row
tTab = Range("H2:H" & iRow)
iLig1 = 276
iLig2 = 305
'
For x = 1 To UBound(tTab)
    If tTab(x, 1) Like "CRS 60 * 120 16GA*" Then
        iLig1 = iLig1 + 1
        Range("H" & x + 1 & ":S" & x + 1).Copy Destination:=wks.Range("L" & iLig1 & ":W" & iLig1)
    End If
    If tTab(x, 1) Like "CRS 48 * 120 13GA*" Then
        iLig2 = iLig2 + 1
        Range("H" & x + 1 & ":S" & x + 1).Copy Destination:=wks.Range("L" & iLig2 & ":W" & iLig2)
    End If
Next
'

Le code est déjà placé dans le petit bouton rouge!

Mais, je ne comprends toujours pas pourquoi il faut les envoyer si bas dans CALCUL PRIX!! Enfin...

Bon travail!

A+

Merci tout fonctionne à merveille et pour ce qui est de ton interrogation c'est que tu est loin d'avoir tout le fichier c'est pour cela que tu n'est pas en mesure de comprendre. Merci pour ta rapidité à répondre c'est super Bonne journée