Importation Condiitonnelle (VBA)

Bonjour à tous,

je cherche un code pour faire une importation sur le même classeur mais d'une feuille à une autre comme ceci :

dans le fichier ci-joint j'ai deux feuille Qte & Ref et je voudrais faire une importation des cellules de la colonne Q en commençant par Q12 de la feuille Qte vers la colonne O de la feuille Ref en commencant par la colonne O6 mais si une cellule de la colonne Q égale à 0 ou vide on l'importe pas sans avoir une ligne avec une cellule vide dans la colonne O sur la feuille Ref Parmis les cellules importées.

et pour chaque cellule importé je veux importer le texte de la cellule B qui correspond a la cellule Q de la feuille Qte vers la cellule R de la feuille Ref

Merci d'avance

Bonjour,

Regarde si cela convient

Bonjour M12,

merci pour ta réponse mais je veux pas avoir des lignes vides dans la feuille de destination

s'il vous plait trouvez moi une solution

Bonjour,

Regarde si c'est ce que tu veux

Merci Beaucoup M12 c'est excatement ce que je cherchais

Bonsoir M12

je reviens vers toi pour une petite modification si c'est possible

maintenant je veux un code pour transferer juste les cellules qui contiennent les sommes (elles sont colorées en vert sur le fichier ci-joint)

CAD sur le classeur QTE je veux transferer juste Q12, Q18 et Q23 autrement dit les cellules qui contiennent la fonction somme ou les cellules qui ont la couleur verte comme ça par la suite si je rajoute des lignes avec la fonction somme sur la colonne Q se transfere aussi vers le classeur ref sans avoir des lignes vide dans la feuille de destination

Merci d'avance

Bonjour

Remplace le code par celui-ci. Il ignore les cases de la colonne Q qui sont vides, contenant des 0 ou de couleur jaune (6)

Sub Transfert()
Application.ScreenUpdating = False
Set F1 = Sheets("Ref")
Set F2 = Sheets("Qte")
n = F1.Cells(65536, 15).End(xlUp).Row
F1.Range("b6:b65536").ClearContents
F1.Range("o6:o65536").ClearContents
n = 6
With F2
 For i = 12 To .Cells(65536, 17).End(xlUp).Row
  If .Cells(i, 17).Value <> "" And .Cells(i, 17).Value > 0 And Cells(i, 17).Interior.ColorIndex <> 6 Then
  'Si tu veux par rapport aux cellules contenant les sommes (en vert) change la ligne du dessus par celle du dessous sans l'apostrophe
  'If .Cells(i, 17).Value <> "" And .Cells(i, 17).Value > 0 And Cells(i, 17).Interior.Color = RGB(102, 255, 153) Then

    F1.Cells(n, 15) = .Cells(i, 17)
    .Cells(i, 17).Copy
    F1.Cells(n, 15).PasteSpecial Paste:=xlPasteValues
    F1.Cells(n, 2) = .Cells(i, 2)
    .Cells(i, 2).Copy
    F1.Cells(n, 2).PasteSpecial Paste:=xlPasteValues
    n = n + 1
  End If
 Next i
End With
Application.CutCopyMode = False
End Sub

Bonjour M12,

merci beaucoup le code marche bien et c'est exactement ce que je voulais.

il reste juste une petite modification que je ne sais pas faire vu que je suis novice en VBA, c'est que dans la feuile de destination Ref ce qui se colle dans la colonne B je veux qu'il se colle dans la colonne R c'est tout

cad le code importe de la colonne Q de la feuille Qte vers la colonne O, et de la colonne B vers la colonne B mais moi je veux qu'il importe de la colonne B vers la colonne R de la feuille Ref

Merci d'avance

Re,

Remplace par le code ci-dessous

Sub Transfert()
Application.ScreenUpdating = False
Set F1 = Sheets("Ref")
Set F2 = Sheets("Qte")
n = F1.Cells(65536, 15).End(xlUp).Row
F1.Range("b6:b65536").ClearContents
F1.Range("o6:o65536").ClearContents
n = 6
With F2
 For i = 12 To .Cells(65536, 17).End(xlUp).Row
  If .Cells(i, 17).Value <> "" And .Cells(i, 17).Value > 0 And Cells(i, 17).Interior.ColorIndex <> 6 Then
  'Si tu veux par rapport aux cellules contenant les sommes change la ligne du dessus par celle du dessous en vert sans l'apostrophe
  'If .Cells(i, 17).Value <> "" And .Cells(i, 17).Value > 0 And Cells(i, 17).Interior.Color = RGB(102, 255, 153) Then

    F1.Cells(n, 15) = .Cells(i, 17)
    .Cells(i, 17).Copy
    F1.Cells(n, 15).PasteSpecial Paste:=xlPasteValues
    F1.Cells(n, 18) = .Cells(i, 2)
    .Cells(i, 2).Copy
    F1.Cells(n, 18).PasteSpecial Paste:=xlPasteValues
    n = n + 1
  End If
 Next i
End With
Application.CutCopyMode = False
End Sub

re,

Merci M12, masi est ce que je ne devrais pas changer aussi :

F1.Range("b6:b65536").ClearContents par F1.Range("R6:R65536").ClearContents ???

si non c'est quoi le role de ces deux ligne :

F1.Range("B6:B65536").ClearContents

F1.Range("O6:O65536").ClearContents

Re,

Tu as raison, un oubli de ma part (mais comme je suis sur un autre projet...), comme quoi le VBA tu y arrives...

Ces lignes servent à supprimer les données déjà présente dans la feuille Ref avant de recopier les données de Qté.

Merci beaucoup M12

bonne chance pour ton projet