Discussion :

[aymanovitch]

Bonjour le forum
j aimerai copier des cellules d une base de donnees automatiquement dans une autre feuille
j ai mis une piece joint pour monter mon cas

[riaolle]

Bonjour et bienvenue au forum
Conformément aux règles du forum, ne joints pas de fichier, mais explique nous ton problème et donne-nous le code que tu as pour l'instant. As-tu un message d'erreur? Si oui, lequel et où? Ne sais-tu pas quelle fonction utiliser pour tel ou tel opération? Ton code tourne, mais ne fais pas ce que tu veux? Que fait-il de différent?
Autres règles du forum : http://club.developpez.com/regles/, en particulier : http://club.developpez.com/regles/#LIV-N
Il y a déjà beaucoup de discussions concernant la copie de données d'une feuille vers une autre. Essaie déjà d'obtenir un début de code grâce à l'enregistreur de macro. C'est une code à adpater.
A bientôt avec plus de précisions !

[aymanovitch]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Sub CommandButton10_Click()
    Sheets("COMMANDE").Range("A2:L" & Range("A655535").End(xlUp).Row + 1).ClearContents
    ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=24, Criteria1:= _
        "<>"
    Range("A2:K" & Range("A655535").End(xlUp).Row).Select
    Selection.Copy Destination:=Sheets("COMMANDE").Range("A2")
    Range("X2:X" & Range("A655535").End(xlUp).Row).Select
    Selection.Copy Destination:=Sheets("COMMANDE").Range("L2")
ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=24
Sheets("COMMANDE").Select
End Sub

et j ai cette partie en jaune
Sheets("COMMANDE").Range("A2:L" & Range("A655535").End(xlUp).Row + 1).ClearContents
ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=24, Criteria1:= _
"<>"

[jerome.vaussenat]

Salut,

que veux tu obtenir avec cette instruction ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=24, Criteria1:= "<>"

Par ce que là, tu demandes à Excel de filtrer ton "Tableau1", sur la 24ème colonne qui doit être égal à "<>" !!

Le fait que la ligne soit en jaune, c'est pour te guider dans la recherche d'erreur (le débeuguage)

[riaolle]

Laquelle des 2 lignes pose problème? Quel est le message d'erreur?
Quelle est ta feuille active lorsque tu lances la macro? Est-ce bien la feuille où il y a les filtres?
QUel est le critère pour le filtre?

Evite au maximum d'utiliser Select/Selection/Activate et leurs copaines. Ceci t'es donné par l'enregistreur de macro, mais il faut adapter le code ensuite :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Private Sub CommandButton10_Click()
 Sheets("COMMANDE").Range("A2:L" & Range("A655535").End(xlUp).Row + 1).ClearContents
 ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=24, Criteria1:= _
 "<>"
 Range("A2:K" & Range("A655535").End(xlUp).Row).Copy Destination:=Sheets("COMMANDE").Range("A2")
 Range("X2:X" & Range("A655535").End(xlUp).Row).Copy Destination:=Sheets("COMMANDE").Range("L2")
 ActiveSheet.ListObjects("Tableau1").Range.AutoFilter Field:=24
 Sheets("COMMANDE").Select
 End Sub

[aymanovitch]

reb
le code fonctionne tres bien mais sans etre copier dans mon logiciel
j explique si j utilise ce code sur une nouvelle feuille il fonctionne parfaitement
mais mon application contienne bcp de code vba donc c est pour cela que ce code n a pas bien fonctionner avec tt les codes que j ai dans la meme feuille
bon 1 le critaire de recherche est de chercher dans la colonne 24 de la feuille "livraisons" la commande et ensuite copier les cellules qui correspond a cette colonne dans la feuille "commande"
les codes que j ai dans ma feuille "livraisons" de mon logiciel original .

Private Sub ComboBox2_Change()
If Me.ComboBox2 <> "" And IsError(Application.Match(Me.ComboBox2, a, 0)) Then
Me.ComboBox2.List = Filter(a, Me.ComboBox2.Text, True, vbTextCompare)
Me.ComboBox2.DropDown
End If
ActiveCell.Value = Me.ComboBox2
End Sub
Private Sub ComboBox3_Change()
ActiveCell.Value = Me.ComboBox3
End Sub
Private Sub ComboBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Me.ComboBox2.List = a
Me.ComboBox2.Activate
Me.ComboBox2.DropDown
End Sub
Private Sub CommandButton1_Click()
Dim msg, style, title

Dim Retour As Integer

With Sheets("LIVRAISON")


'---------------- Impression noir et blanc ou couleur ------------------------
Retour = MsgBox("Voulez-vous une copie couleur : N/O ", vbNoYes + vbCritical)
If Retour = vbNo Then
With ActiveSheet.PageSetup
.BlackAndWhite = True
End With
End If
ActiveSheet.PageSetup.PrintArea = "B2:I55"
'ActiveSheet.PrintPreview
ActiveWindow.SelectedSheets.PrintPreview 'PrintOut copies:=1
End With
End Sub

Private Sub CommandButton2_Click()
UserForm3.Show
End Sub


Private Sub Worksheet_SelectionChange(ByVal target As Range)

If Not Intersect([H7:H35], target) Is Nothing Then
Application.OnKey Key:="~", procedure:="retour_colonneC"
End If

If Not Intersect([H4:H5], target) Is Nothing Then
Application.OnKey Key:="~", procedure:="retour_colonneC2"
End If

If Not Intersect([C7:C35], target) Is Nothing And target.Count = 1 Then
a = Application.Transpose(Sheets("bdd").Range("liste"))
Me.ComboBox2.List = a
Me.ComboBox2.Height = target.Height + 3
Me.ComboBox2.Width = target.Width
Me.ComboBox2.Top = target.Top
Me.ComboBox2.Left = target.Left
Me.ComboBox2 = target
Me.ComboBox2.Visible = True
Me.ComboBox2.Activate
'Me.ComboBox1.DropDown ' ouverture automatique au clic dans la cellule (optionel)
Else
Me.ComboBox2.Visible = False
End If
If Not Intersect([d7:d35], target) Is Nothing And target.Count = 1 Then
b = Range("liste_depots_bon_livraison")
Me.ComboBox3.List = b
Me.ComboBox3.Height = target.Height + 3
Me.ComboBox3.Width = target.Width
Me.ComboBox3.Top = target.Top
Me.ComboBox3.Left = target.Left
Me.ComboBox3 = target
Me.ComboBox3.Visible = True
Me.ComboBox3.Activate
'Me.ComboBox1.DropDown ' ouverture automatique au clic dans la cellule (optionel)
Else
Me.ComboBox3.Visible = False
End If

If Not Intersect(target, Worksheets("LIVRAISON").Range("C5964")) Is Nothing Then
Worksheets("LIVRAISON").Range("R12").Select
End If

If Not Intersect(target, Worksheets("LIVRAISON").Range("J16")) Is Nothing Then
Worksheets("LIVRAISON").Range("R12").Select
End If

If Not Intersect(target, Worksheets("LIVRAISON").Range("A1:B6")) Is Nothing Then
Worksheets("LIVRAISON").Range("R12").Select
End If

If Not Intersect(target, Worksheets("LIVRAISON").Range("E2:E4")) Is Nothing Then
Worksheets("LIVRAISON").Range("R12").Select
End If

If Not Intersect(target, Worksheets("LIVRAISON").Range("C2:H2")) Is Nothing Then
Worksheets("LIVRAISON").Range("R12").Select
End If

If Not Intersect(target, Worksheets("LIVRAISON").Range("B6:I6")) Is Nothing Then
Worksheets("LIVRAISON").Range("R12").Select
End If

If Not Intersect(target, Worksheets("LIVRAISON").Range("D1:I1")) Is Nothing Then
Worksheets("LIVRAISON").Range("R12").Select
End If

If Not Intersect(target, Worksheets("LIVRAISON").Range("R1:R2")) Is Nothing Then
Worksheets("LIVRAISON").Range("R12").Select
End If

If Not Intersect(target, Worksheets("LIVRAISON").Range("F37:I38")) Is Nothing Then
Worksheets("LIVRAISON").Range("R12").Select
End If

If Not Intersect(target, Worksheets("LIVRAISON").Range("I46")) Is Nothing Then
Worksheets("LIVRAISON").Range("R12").Select
End If

If Not Intersect(target, Worksheets("LIVRAISON").Range("J7:J35")) Is Nothing Then
Worksheets("LIVRAISON").Range("R12").Select
End If

If Not Intersect(target, Worksheets("LIVRAISON").Range("N1:N1")) Is Nothing Then
Worksheets("LIVRAISON").Range("R12").Select
End If

If Not Intersect(target, Worksheets("LIVRAISON").Range("T7:AN35")) Is Nothing Then
Worksheets("LIVRAISON").Range("R12").Select
End If

If Not Intersect(target, Worksheets("LIVRAISON").Range("E5")) Is Nothing Then
Worksheets("LIVRAISON").Range("R12").Select
End If

If Not Intersect(target, Worksheets("LIVRAISON").Range("I6:I35")) Is Nothing Then
Worksheets("LIVRAISON").Range("R12").Select
End If

End Sub

' code pour avertirtissement de doublon dans la colonne "C"

Private Sub Worksheet_Change(ByVal target As Excel.Range)
Dim Colonne As Integer
Dim Adresse As String

'On sort si plus d'une cellule a été modifiée
If target.Count > 1 Then Exit Sub
'On sort si la cellule modifiée est vide
If target.Value = "" Then Exit Sub

'Définit la colonne à vérifier (1=Colonne A, 2=colonne B ...etc...)
Colonne = 3

'Vérifie si c'est la colonne cible a été modifiée
If target.Column = Colonne Then

'Recherche si la nouvelle donnée existe déjà dans la colonne.
Adresse = Columns(Colonne).Find(What:=target.Value, After:=target.Offset(1, 0), LookAt:=xlWhole, _
SearchDirection:=xlNext).Address

'Si l'adresse de cellule trouvée ne correspond pas à la cellule modifiée, cela
'signifie qu'il y a un doublon dans la colonne.
If Adresse <> target.Address Then

MsgBox "La Réference '" & target & "' Déjà saisie ", vbExclamation

End If
End If

End Sub




Sub masquer_barre()
ActiveWindow.DisplayWorkbookTabs = False
End Sub

[aymanovitch]

BONJOUR
j explique ma demande sans piece joint
j ai une feuille "livraison" qui contienne 24 colonnes et dans la 24 eme colonne j ai parfois des celulles qui contienne la notion "commande1" et "commande2" et ainsi de suite mais ils ne sont pas les uns apres les autres
ce que je veux c est a chaque fois j ai une notion "commande" dans la colonne 24 excel copie automatiquement les cellules qui sont dans la meme ligne de la notion "commande1 ou 2" dans une autre feuille appele " commande"
et tt fois il y a une nouvelle commande dans la feuille "livraison" excel la copie automatiquement sur la feuille "commande"
j espere que j ai pu bien expliquer
n hésitez pas a demander des explications
et merci