COPIE QUI SE SUPPERPOSE APRES PROCEDURE

[br44]

Bonjour le forum

je suis désoler de vous soliciter à nouveau mais je n'arrive pas à résoudre mon probléme de copie à partir de deus feuille dans un classeur vers une feuille d'un autres classeur
j'ai essayer plusieur version pour aller à la ligne de la premiére copie mais el résultat et toujour le meme :

il m'affiche la deuxième copie mais pas la première .
Or je voudrais voir les deux copies l'une sous l'autres.

vous trouvrer si join un fichier avec le fichier contenant les feuille à copier et le classeur pour les recevoires .

à noter j'ai oublier de modifier le début de ma procédure consernant :
Chemin := c:\\ mon chemin \\'
je vous laisse le faire en fonction de votre position au sein de vos programes ,de plus l'userfron se commande par F5 du programe vba

les tableaux sont de taille indentique ,mais les information qu'ils conteinnent viennes de sources différantes donc ne soyer pas surpris par ma demandes .

Le probleme se situe au niveau :
sud commandButton 2 _click()
voila tous ce que je peux vous données comme élélments en espérant qu'ils vous suffisent pour m'aider .
trés grand merci par avances à vous tous . je reste à votres disposition pour toutes questions que vous auriez à me poser
à plus sur le forum
br44
[file name=copsup.zip size=30876]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/copsup.zip[/file]

 

[_Thierry]

Bonjour Br44, le Forum

J'ai rapidement élagué un peu tout ceci, mais rapidos, car je suis assez occupé en ce moment.

Option Explicit

Const Chemin As String = 'C:\Mes documents\Jbr44\copsup\ARCHIVES.xls'
 
Private Sub UserForm_Initialize()
Dim P As Range
Dim Cel As Range

Set P = Range('A5:A' & Range('A65536').End(xlUp).Row)

    With Mois
        .AddItem ('JANVIER')
        .AddItem ('FEVRIER')
        .AddItem ('MARS')
        .AddItem ('AVRIL')
        .AddItem ('MAI')
        .AddItem ('JUIN')
        .AddItem ('JUILLET')
        .AddItem ('AOUT')
        .AddItem ('SEPTEMBRE')
        .AddItem ('OCTOBRE')
        .AddItem ('NOVENBRE')
        .AddItem ('DECEMBRE')
    End With

    For Each Cel In P
        Journée.AddItem (Cel.Value)
    Next Cel

    With Journée
        .ListIndex = 0
        .SelStart = 0
        .SelLength = Len(Journée.Value)
    End With

End Sub
Private Sub CommandButton1_Click()
Dim P As Range
Dim Cel As Range
Dim L As Byte
Dim X As Byte

With Sheets('retour')
    .Range('G3').Value = RefProduit.Value
      NomProduit.Value = .Range('A4').Value
    .Range('C3').Value = Mois.Value
End With


For Each Cel In P
    If Cel.Value = (Journée.Value) Then
        L = Cel.Row
        Exit For
    End If
Next Cel

For X = 3 To 8
        Cells(L, X - 1).Value = Me.Controls('TextBox' & X).Value
Next X
End Sub
Private Sub CommandButton2_Click()
Dim Wb1 As Workbook
Dim Wb2 As Workbook
Dim Mois As String

Mois = ActiveSheet.Range('C3').Value

Set Wb1 = Workbooks.Open(Chemin)
Set Wb2 = ThisWorkbook


Wb2.Sheets('retour').UsedRange.Copy Destination:=Wb1.Sheets(Mois).Range('A65536').End(xlUp).Offset(1, 0)
Wb2.Sheets('distribution').UsedRange.Copy Destination:=Wb1.Sheets(Mois).Range('A65536').End(xlUp).Offset(1, 0)

Workbooks('ARCHIVES.XLS').Save
End Sub

NB il faudrait voir à éviter de travailler par Formule et VBA et même temps (for 'NomProduit.Value = .Range('A4').Value')

Bon Dimanche.
[ol]@+Thierry[/ol]

 

[br44]

re:bonsoir le forum ,bonsoir Thierry

Un trés trés grand merci à toi pour avoir pris du temps pour me répondre et d'avoir mis cette solution qui fonctionne trés bien .

la seul petite chose est que les copie ne se font pas au même format que l'original ,et que la formule des cellules A4 des feuilles'retour'et 'distribution' ne fonctionne pas au niveau des copies ,il faut la reprendre pour changer les les refs puis les valider .

je ne sais pas si ces normal ou pas enfin se n'est qu'un petit détail .

je t'addresse de nouveaux tout mes remerciments et te dis cordialement à plus sur le forum

Br44

 

[_Thierry]

Bonsoir Br44

De rien, ce n'était vraiment pas grand chose.

Pour ton problème de 'A4' c'est exactement dû à ce que je t'ai expliqué plus en avant, ce mélange Formules et VBA...

Pour la Mise en Forme, et bien le plus simple serait de formatter ton Classeur Archives.xls mais bon, en VBA on peut aussi s'amuser...

Revoici une Version :

Option Explicit
Option Compare Text

Const Chemin As String = 'C:\Mes documents\Jacques\br44\copsup\ARCHIVES.xls'
Private P As Range

Private Sub UserForm_Initialize()
Dim Cel As Range

Set P = Range('A5:A' & Range('A65536').End(xlUp).Row)

    With Mois
        .AddItem ('JANVIER')
        .AddItem ('FEVRIER')
        .AddItem ('MARS')
        .AddItem ('AVRIL')
        .AddItem ('MAI')
        .AddItem ('JUIN')
        .AddItem ('JUILLET')
        .AddItem ('AOUT')
        .AddItem ('SEPTEMBRE')
        .AddItem ('OCTOBRE')
        .AddItem ('NOVEMBRE')
        .AddItem ('DECEMBRE')
    End With

    For Each Cel In P
        Journée.AddItem (Cel.Value)
    Next Cel

    With Journée
        .ListIndex = 0
        .SelStart = 0
        .SelLength = Len(Journée.Value)
    End With

End Sub
Private Sub CommandButton1_Click()
Dim Cel As Range
Dim L As Byte
Dim X As Byte
Dim WS As Variant


For Each WS In Array('retour', 'Distribution')
    With ThisWorkbook.Sheets(WS)
        .Range('G3').Value = RefProduit.Value
          NomProduit.Value = MyFunctionLookUp(.Range('G3').Value)
        .Range('A4') = NomProduit
        .Range('C3').Value = Mois.Value
    End With
Next WS




For Each Cel In P
    If Cel.Value = (Journée.Value) Then
        L = Cel.Row
        Exit For
    End If
Next Cel

For X = 3 To 8
        Cells(L, X - 1).Value = Me.Controls('TextBox' & X).Value
Next X
End Sub

Private Function MyFunctionLookUp(ByVal RefProd As String) As String
Dim Plage As Range
Dim Cell As Range

With ThisWorkbook.Sheets('PRODUIT')
    Set Plage = .Range(.Range('A2'), .Range('A65536').End(xlUp))
End With

    For Each Cell In Plage
        If Cell = RefProd Then
            MyFunctionLookUp = Cell.Offset(0, 1)
            Exit For
        End If
    Next
End Function



Private Sub CommandButton2_Click()
Dim Wb1 As Workbook
Dim Wb2 As Workbook
Dim Mois As String
Dim i As Integer
Dim Y As Integer

Mois = ActiveSheet.Range('C3').Value

Set Wb1 = Workbooks.Open(Chemin)
Set Wb2 = ThisWorkbook


Wb2.Sheets('retour').UsedRange.Copy Destination:=Wb1.Sheets(Mois).Range('A65536').End(xlUp).Offset(1, 0)
Wb2.Sheets('distribution').UsedRange.Copy Destination:=Wb1.Sheets(Mois).Range('A65536').End(xlUp).Offset(1, 0)

    With Wb1.Sheets(Mois)
        For i = 1 To .UsedRange.Columns.Count
            .Columns(i).ColumnWidth = Wb2.Sheets('retour').Columns(i).ColumnWidth
        Next
       
        Y = 1
        For i = 2 To .UsedRange.Rows.Count
            .Rows(i).RowHeight = Wb2.Sheets('retour').Rows(Y).RowHeight
            Y = IIf(Y > 15 / 2, 1, Y + 1)
        Next
    End With



Workbooks('ARCHIVES.XLS').Save
End Sub

NB Il n'y a aucune parade contre le mauvais sens de manipulation par l'utilsateur de ton UserForm (ce qu'il faudrait envisager).

Bonne Soirée
[ol]@+Thierry[/ol]

 

[br44]

re:bosoir le forum,bonsoir Thierry

je peux enfin répondre à ton dernier message pour laquelle je te remercie .

tous se passe bien à part que j'ai un beug au niveau de la ligne :

.Columns(i).ColumnWidh=Wb2.Sheets('retour').columns(i).ColumnWidh

Il me déclare une ERREUR '438' roriétée ou Méthode non générée par cet objet .

voilà ou j'en suis à l'heure actuel .

pour répondre à ta question ,je suis d'accord mais à part bloquer l'ordre de tabulation je ne vois pas comment protéger mon Userfrom?
je ne connais pas suffisament le vba pour ça .

D'autres part je voudrais savoire si il est possible de rajouter une fonction dans la procédure .

Il s'agirait d' une boucle capable de rappeller les fiches dejà copier en fonction du noms des produits . Cette boucle me permettrais de pouvoir completer les fiches en cas où les données seraient rentrées partiellement ?

J'espère ne pas trop abuser de ton temps et te remercie de ta patience .

Sur ce je te souhaite une bonne soirée et te dis à plus sur ce forum

A BIENTOT BR44

 

[br44]

re: rebonsoir le forum

je suis désolé pour le ' ' faute de frappe


bonne soirée à tous et toutes
br44