VB

Résolu
samir83 -  
 samir83 -
Bonjour,
j'ai besoin d'aide afin de pouvoir remplir une feuille excel automatiquement à partir d'une autre feuille excel du meme classeur qui contient des valeurs.

le probléme qui me bloc est le suivant :

Dans la premiere feuille j'ai des comptes (exemple 1111) dans la premiere colonne et des valeurs dans la deuxième.

dans les autres feuilles , je n'ai que des sous comptes (exemple 111)

je veu faire appel aux valeurs de la premiere feuille vers les autres feuilles et je veu que VB reconnait le compte et déplace la valeur.

exemple :

feuille 1 contient les comptes suivants : 1111, 1119, 1117, 1112 devant lesquelles il y a des valeurs
feuille 2 contient le sous compte suivant : 111

je veu une fonction qui peut reconnaitre les comptes qui contiennent le sous compte 111 et les mettre sur la feuille 2 avec leurs valeurs.

si vous pouvez m'aider, merci d'avance.
Configuration: Windows XP Internet Explorer 7.0

1 réponse

  1. jjsteing Messages postés 1613 Date d'inscription   Statut Contributeur Dernière intervention   181
     
    Bonjour :)
    Vouci le code demander à mettre en macro ou , comme ici (http://dl.free.fr/getfile.pl?file=/kF0ItT4B dans un bouton de commande..

    Private Sub CommandButton1_Click()
    Dim CelleulePrincipale As String
    Dim Cellule2 As String
    Dim i As Integer, j As Integer, Dercelli As Integer, Dercellj As Integer
    Dim LigneEnCours As Integer
    a = Worksheets("Feuil2").Range("A1").End(xlDown).Address
    Dercelli = Right(a, Len(a) - InStr(2, a, "$"))
    LigneEnCour = 1

    For i = 1 To Dercelli + 1
    i = LigneEnCour
    CelleulePrincipale = Worksheets("Feuil2").Cells(i, 1)
    a = Worksheets("Feuil1").Range("A1").End(xlDown).Address
    Dercellj = Right(a, Len(a) - InStr(2, a, "$"))
    For j = 1 To Dercellj
    Cellule2 = Worksheets("Feuil1").Cells(j, 1)
    If CelleulePrincipale = Left(Cellule2, Len(CelleulePrincipale)) And _
    Cellule2 <> CelleulePrincipale Then
    Worksheets("Feuil2").Rows(LigneEnCour + 1).Insert Shift:=xlDown
    Worksheets("Feuil2").Cells(LigneEnCour + 1, 1) = Worksheets("Feuil1").Cells(j, 1)
    Worksheets("Feuil2").Cells(LigneEnCour + 1, 2) = Worksheets("Feuil1").Cells(j, 2)
    LigneEnCour = LigneEnCour + 1
    End If
    Next
    a = Worksheets("Feuil2").Range("A1").End(xlDown).Address
    Dercelli = Right(a, Len(a) - InStr(2, a, "$"))
    LigneEnCour = LigneEnCour + 1
    Next
    End Sub
    0
    1. samir83
       
      je vous remercie beaucoup pour votre aide, je suis encore débutant en language VBA, je cherche depuis longtemps cette fonction afin de faciliter mon travail. encore merci.

      bonne journée.
      0