Macro recuperation de données sur deux Excel
Bonjour,
Je suis nouvelle pardonnez moi si je n'ai pas écrit dans la bonne partie du forum
Alors je vous présente mon soucis:
J'aimerais récupérer des informations d'un fichier classe A dans un fichier classe B automatiquement car je perd énormément de temps a remplir à la main les informations
Sachant que le fichier classe B c'est une sorte d'un fichier base donnée/ suivi et que le fichier A, je peux en avoir plusieurs
le fichier classe B doit se remplir à la suite des lignes deja remplie en incrementant la premiere case
Je ne sais pas si je suis clair
Je met en copie les deux fichier d'exemple
Merci d'avance
Bonjour -missya et bienvenue sur le forum,
Ci-joint ton fichier avec une partie des formules à utiliser pour récupérer les informations d'un fichier à l'autre grâce à un simple "cherchev".
Il faudra sûrement modifier le répertoire du fichier B, car celui-ci est adapté à mon ordinateur.
d3d9x a écrit :Bonjour -missya et bienvenue sur le forum,
Ci-joint ton fichier avec une partie des formules à utiliser pour récupérer les informations d'un fichier à l'autre grâce à un simple "cherchev". Il faudra sûrement modifier le répertoire du fichier B, car celui-ci est adapté à mon ordinateur.
Merci
Je vais checker dès que je rentre mais si ce n'est pas une macro ça va être compliquer car le fichier A est rempli toute les semaines avec des infos différentes j'aimerais un bouton qui incrémente le fichier B et le rempli à partir de la ligne vide
Je ne sais si je suis claire :/
d3d9x a écrit :Bonjour -missya et bienvenue sur le forum,
Ci-joint ton fichier avec une partie des formules à utiliser pour récupérer les informations d'un fichier à l'autre grâce à un simple "cherchev". Il faudra sûrement modifier le répertoire du fichier B, car celui-ci est adapté à mon ordinateur.
Bonjour d3d9x,
Merci encore pour ce que tu as fais mais en fait c'est pas ca
j'aimerais que le fichier classe A mette à jour le fichier classe B ( sachant que le fichier classe A contient deja des lignes et donc pour chaque nouveau fichier classe A la ligne vide se met à jour )
Le fichier classe A j'en reçois plusieurs version car c'est rempli par différente personne
Espérant que je me suis bien expliquée
Merci encore!
pas d'idée?
j'ai essayé de faire quelque chose :
Sub Copier()
'Data = ActiveWorkbook.Name
Dim w1 As String
Dim w2 As String
Dim LigneEncours As Long
'Chargement du nom des feuilles origine et destination
Set w1 = ActiveWorkbook.Sheets("Feuil1") 'fichier classeB
Set w2 = Workbooks("classA.xls").Sheets("Feuil1")
LigneEncours = Worksheets(w1).Range("1" & Rows.Count).End(xlUp).Row + 1
'Copie des valeurs du classeB dans classeA dans la ligne vide de la feuil1
With Worksheets(Cible)
w1.Activate
w2.Activate
Worksheets(w2).Range("B8").Copy .Range("B" & LigneEncours)
Worksheets(w2).Range("B9").Copy .Range("C" & LigneEncours)
Worksheets(w2).Range("B10").Copy .Range("F" & LigneEncours)
Worksheets(w2).Range("B11").Copy .Range("H" & LigneEncours)
Worksheets(w2).Range("B13").Copy .Range("I" & LigneEncours)
Worksheets(w2).Range("B14").Copy .Range("J" & LigneEncours)
Worksheets(w2).Range("B19").Copy .Range("K" & LigneEncours)
Worksheets(w2).Range("B18").Copy .Range("L" & LigneEncours)
Worksheets(w2).Range("B20").Copy .Range("M" & LigneEncours)
Worksheets(w2).Range("B21").Copy .Range("N" & LigneEncours)
Worksheets(w2).Range("B23").Copy .Range("O" & LigneEncours)
End With
End SubMais ca marche pas
Bonjour.
Tu reçois donc un fichier A et tu veux qu'en utilisant une macro sur B tu récupères l'info sur une nouvelle ligne ?
Le fichier de type A est-il amené à évoluer ? (comprendre : est-ce que telle donnée sera toujours sur telle ligne ?) Idem pour B.
Bonne journée.
Elhevan a écrit :Bonjour.
Tu reçois donc un fichier A et tu veux qu'en utilisant une macro sur B tu récupères l'info sur une nouvelle ligne ?
Le fichier de type A est-il amené à évoluer ? (comprendre : est-ce que telle donnée sera toujours sur telle ligne ?) Idem pour B.
Bonne journée.
Bonjour Elhevan,
Merci pour ta réponse
Le fichier type classe A les données et le nom changent mais pas le format
Donc oui, j'aimerais qu'une macro quelques le nom du fichier du type A remplisse sur une nouvelle ligne du fichier B les données
J'ai trouvé ce bout de code aussi pour selectionner le fichier quelques soit le nom du fichier type A :
Sub remplissage()
' remplissage Macro
'
Dim tableau_noms_fichiers As Variant
Dim i As Integer
Dim w1 As Workbook
tableau_noms_fichiers = Application.GetOpenFilename _
(Title:="Choisir le fichier à importer", MultiSelect:=False)
Stop
Workbooks.Open tableau_noms_fichiers
Set w1 = ActiveWorkbook
w1.Close
Set w1 = Nothing
End SubC'est moche, mais je pense que ça marche, j'ai repris ton bout de code.
Sub remplissage()
' remplissage Macro
'
Dim FicheA_fichiers As Variant
Dim FicheB As String
FicheB = "Nom de ton fichier B"
FicheA = Application.GetOpenFilename _
(Title:="Choisir le fichier à importer", MultiSelect:=False)
Stop
Workbooks.Open FicheA
Dim i As Integer
i = 2
Do Until IsEmpty(Workbooks(FicheB).Worksheets(Feuil1).Cells(i, 1)) 'va chercher la ligne vide
i = i + 1
Loop
Dim j As Integer
j = 1
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = i
j = j + 1
If IsEmpty(Workbooks(FicheA).Worksheets(Feuil1).Cells(3, 2)) Then
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = "B"
Else
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = "A"
End If
j = j + 1 ' Passe à date
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(1, 3).Value
j = j + 6 'Passe à nom P
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(8, 2).Value
j = j + 1 'Prénom P
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(9, 2).Value
j = j + 1 'Adresse p
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(10, 2).Value
j = j + 1 ' Tel P
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(11, 2).Value
j = j + 1 ' NomC
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(13, 2).Value
j = j + 1 'PrenomC
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(14, 2).Value
j = j + 1 'Adresse C
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(15, 2).Value
j = j + 1 ' tel C
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(16, 2).Value
j = j + 2 'info 1
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(18, 2).Value
j = j + 1 'info 2
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(19, 2).Value
j = j + 2 'info 3
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(20, 2).Value
j = j + 1 ' info 4
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(21, 2).Value
j = j + 2 'info 5
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(22, 2).Value
j = j + 2 'info 6
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(23, 2).Value
j = j + 1 'info 7
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(24, 2).Value
j = j + 1 'info 8
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(25, 2).Value
End SubElhevan a écrit :C'est moche, mais je pense que ça marche, j'ai repris ton bout de code.
Sub remplissage() ' remplissage Macro ' Dim FicheA_fichiers As Variant Dim FicheB As String FicheB = "Nom de ton fichier B" FicheA = Application.GetOpenFilename _ (Title:="Choisir le fichier à importer", MultiSelect:=False) Stop Workbooks.Open FicheA Dim i As Integer i = 2 Do Until IsEmpty(Workbooks(FicheB).Worksheets(Feuil1).Cells(i, 1)) 'va chercher la ligne vide i = i + 1 Loop Dim j As Integer j = 1 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = i j = j + 1 If IsEmpty(Workbooks(FicheA).Worksheets(Feuil1).Cells(3, 2)) Then Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = "B" Else Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = "A" End If j = j + 1 ' Passe à date Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(1, 3).Value j = j + 6 'Passe à nom P Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(8, 2).Value j = j + 1 'Prénom P Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(9, 2).Value j = j + 1 'Adresse p Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(10, 2).Value j = j + 1 ' Tel P Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(11, 2).Value j = j + 1 ' NomC Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(13, 2).Value j = j + 1 'PrenomC Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(14, 2).Value j = j + 1 'Adresse C Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(15, 2).Value j = j + 1 ' tel C Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(16, 2).Value j = j + 2 'info 1 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(18, 2).Value j = j + 1 'info 2 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(19, 2).Value j = j + 2 'info 3 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(20, 2).Value j = j + 1 ' info 4 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(21, 2).Value j = j + 2 'info 5 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(22, 2).Value j = j + 2 'info 6 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(23, 2).Value j = j + 1 'info 7 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(24, 2).Value j = j + 1 'info 8 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(25, 2).Value End Sub
Merci ! mais la macro s’arrête quand j'ouvre le fichier classeA :s
Ca m'apprendra à reprendre aveuglement les bouts de code, je vois une ligne "Stop" qui ne me plait pas beaucoup
(Pense à remplacer dans "FicheB = "Nom de ton fichier B"" aussi
Sub remplissage()
' remplissage Macro
'
Dim FicheA_fichiers As Variant
Dim FicheB As String
FicheB = "Nom de ton fichier B"
FicheA = Application.GetOpenFilename _
(Title:="Choisir le fichier à importer", MultiSelect:=False)
Workbooks.Open FicheA
Dim i As Integer
i = 2
Do Until IsEmpty(Workbooks(FicheB).Worksheets(Feuil1).Cells(i, 1)) 'va chercher la ligne vide
i = i + 1
Loop
Dim j As Integer
j = 1
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = i
j = j + 1
If IsEmpty(Workbooks(FicheA).Worksheets(Feuil1).Cells(3, 2)) Then
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = "B"
Else
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = "A"
End If
j = j + 1 ' Passe à date
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(1, 3).Value
j = j + 6 'Passe à nom P
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(8, 2).Value
j = j + 1 'Prénom P
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(9, 2).Value
j = j + 1 'Adresse p
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(10, 2).Value
j = j + 1 ' Tel P
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(11, 2).Value
j = j + 1 ' NomC
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(13, 2).Value
j = j + 1 'PrenomC
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(14, 2).Value
j = j + 1 'Adresse C
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(15, 2).Value
j = j + 1 ' tel C
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(16, 2).Value
j = j + 2 'info 1
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(18, 2).Value
j = j + 1 'info 2
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(19, 2).Value
j = j + 2 'info 3
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(20, 2).Value
j = j + 1 ' info 4
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(21, 2).Value
j = j + 2 'info 5
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(22, 2).Value
j = j + 2 'info 6
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(23, 2).Value
j = j + 1 'info 7
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(24, 2).Value
j = j + 1 'info 8
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(25, 2).Value
End SubElhevan a écrit :Ca m'apprendra à reprendre aveuglement les bouts de code, je vois une ligne "Stop" qui ne me plait pas beaucoup
Essaye sans. (Pense à remplacer dans "FicheB = "Nom de ton fichier B"" aussi
Sub remplissage() ' remplissage Macro ' Dim FicheA_fichiers As Variant Dim FicheB As String FicheB = "Nom de ton fichier B" FicheA = Application.GetOpenFilename _ (Title:="Choisir le fichier à importer", MultiSelect:=False) Workbooks.Open FicheA Dim i As Integer i = 2 Do Until IsEmpty(Workbooks(FicheB).Worksheets(Feuil1).Cells(i, 1)) 'va chercher la ligne vide i = i + 1 Loop Dim j As Integer j = 1 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = i j = j + 1 If IsEmpty(Workbooks(FicheA).Worksheets(Feuil1).Cells(3, 2)) Then Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = "B" Else Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = "A" End If j = j + 1 ' Passe à date Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(1, 3).Value j = j + 6 'Passe à nom P Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(8, 2).Value j = j + 1 'Prénom P Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(9, 2).Value j = j + 1 'Adresse p Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(10, 2).Value j = j + 1 ' Tel P Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(11, 2).Value j = j + 1 ' NomC Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(13, 2).Value j = j + 1 'PrenomC Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(14, 2).Value j = j + 1 'Adresse C Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(15, 2).Value j = j + 1 ' tel C Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(16, 2).Value j = j + 2 'info 1 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(18, 2).Value j = j + 1 'info 2 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(19, 2).Value j = j + 2 'info 3 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(20, 2).Value j = j + 1 ' info 4 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(21, 2).Value j = j + 2 'info 5 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(22, 2).Value j = j + 2 'info 6 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(23, 2).Value j = j + 1 'info 7 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(24, 2).Value j = j + 1 'info 8 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(25, 2).Value End Sub
haha oui en effet mais ca ne resout pas le soucis ca doit etre un probleme de nom du fichier
voila le fichier classeB avec la macro mais ca ne marche pas :s ca se bloque à la ligne qui cherche les lignes vide
Est ce que tu peux regarder stp dans le fichier ce qui ne va pas ?
Merciii encore!!!
Tentons
Sub remplissage()
' remplissage Macro
'
Dim FicheA_fichiers As Variant
Dim FicheB As String
FicheB = "ClasseB.xls"
FicheA = Application.GetOpenFilename _
(Title:="Choisir le fichier à importer", MultiSelect:=False)
Workbooks.Open FicheA
Dim Feuil1 As String
Feuil1 = "Feuil1"
Dim count As Integer
count = InStrRev(FicheA, "\")
Dim taille As Integer
taille = Len(FicheA)
FicheA = Right(FicheA, taille - count)
Dim i As Integer
i = 2
ThisWorkbook.Activate
Do Until IsEmpty(Worksheets(Feuil1).Cells(i, 1)) 'va chercher la ligne vide
i = i + 1
Loop
Dim j As Integer
j = 1
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = i
j = j + 1
If IsEmpty(Workbooks(FicheA).Worksheets(Feuil1).Cells(3, 2)) Then
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = "B"
Else
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = "A"
End If
j = j + 1 ' Passe à date
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(1, 3).Value
j = j + 6 'Passe à nom P
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(8, 2).Value
j = j + 1 'Prénom P
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(9, 2).Value
j = j + 1 'Adresse p
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(10, 2).Value
j = j + 1 ' Tel P
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(11, 2).Value
j = j + 1 ' NomC
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(13, 2).Value
j = j + 1 'PrenomC
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(14, 2).Value
j = j + 1 'Adresse C
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(15, 2).Value
j = j + 1 ' tel C
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(16, 2).Value
j = j + 2 'info 1
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(18, 2).Value
j = j + 1 'info 2
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(19, 2).Value
j = j + 2 'info 3
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(20, 2).Value
j = j + 1 ' info 4
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(21, 2).Value
j = j + 2 'info 5
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(22, 2).Value
j = j + 2 'info 6
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(23, 2).Value
j = j + 1 'info 7
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(24, 2).Value
j = j + 1 'info 8
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(25, 2).Value
End SubElhevan a écrit :Tentons
(pense à mettre l'extension dans ton fiche B Sub remplissage() ' remplissage Macro ' Dim FicheA_fichiers As Variant Dim FicheB As String FicheB = "ClasseB.xls" FicheA = Application.GetOpenFilename _ (Title:="Choisir le fichier à importer", MultiSelect:=False) Workbooks.Open FicheA Dim Feuil1 As String Feuil1 = "Feuil1" Dim count As Integer count = InStrRev(FicheA, "\") Dim taille As Integer taille = Len(FicheA) FicheA = Right(FicheA, taille - count) Dim i As Integer i = 2 ThisWorkbook.Activate Do Until IsEmpty(Worksheets(Feuil1).Cells(i, 1)) 'va chercher la ligne vide i = i + 1 Loop Dim j As Integer j = 1 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = i j = j + 1 If IsEmpty(Workbooks(FicheA).Worksheets(Feuil1).Cells(3, 2)) Then Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = "B" Else Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = "A" End If j = j + 1 ' Passe à date Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(1, 3).Value j = j + 6 'Passe à nom P Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(8, 2).Value j = j + 1 'Prénom P Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(9, 2).Value j = j + 1 'Adresse p Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(10, 2).Value j = j + 1 ' Tel P Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(11, 2).Value j = j + 1 ' NomC Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(13, 2).Value j = j + 1 'PrenomC Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(14, 2).Value j = j + 1 'Adresse C Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(15, 2).Value j = j + 1 ' tel C Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(16, 2).Value j = j + 2 'info 1 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(18, 2).Value j = j + 1 'info 2 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(19, 2).Value j = j + 2 'info 3 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(20, 2).Value j = j + 1 ' info 4 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(21, 2).Value j = j + 2 'info 5 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(22, 2).Value j = j + 2 'info 6 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(23, 2).Value j = j + 1 'info 7 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(24, 2).Value j = j + 1 'info 8 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(25, 2).Value End Sub
aaaaaaaaaaaaaaaaaaaaaaah ca marche beaucoup mieux merciii!
je vais le faire maintenant dans les fichiers d'origine et je te tiens au courant
mercii merci !
Elhevan a écrit :Tentons
(pense à mettre l'extension dans ton fiche B Sub remplissage() ' remplissage Macro ' Dim FicheA_fichiers As Variant Dim FicheB As String FicheB = "ClasseB.xls" FicheA = Application.GetOpenFilename _ (Title:="Choisir le fichier à importer", MultiSelect:=False) Workbooks.Open FicheA Dim Feuil1 As String Feuil1 = "Feuil1" Dim count As Integer count = InStrRev(FicheA, "\") Dim taille As Integer taille = Len(FicheA) FicheA = Right(FicheA, taille - count) Dim i As Integer i = 2 ThisWorkbook.Activate Do Until IsEmpty(Worksheets(Feuil1).Cells(i, 1)) 'va chercher la ligne vide i = i + 1 Loop Dim j As Integer j = 1 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = i j = j + 1 If IsEmpty(Workbooks(FicheA).Worksheets(Feuil1).Cells(3, 2)) Then Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = "B" Else Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = "A" End If j = j + 1 ' Passe à date Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(1, 3).Value j = j + 6 'Passe à nom P Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(8, 2).Value j = j + 1 'Prénom P Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(9, 2).Value j = j + 1 'Adresse p Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(10, 2).Value j = j + 1 ' Tel P Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(11, 2).Value j = j + 1 ' NomC Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(13, 2).Value j = j + 1 'PrenomC Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(14, 2).Value j = j + 1 'Adresse C Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(15, 2).Value j = j + 1 ' tel C Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(16, 2).Value j = j + 2 'info 1 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(18, 2).Value j = j + 1 'info 2 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(19, 2).Value j = j + 2 'info 3 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(20, 2).Value j = j + 1 ' info 4 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(21, 2).Value j = j + 2 'info 5 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(22, 2).Value j = j + 2 'info 6 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(23, 2).Value j = j + 1 'info 7 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(24, 2).Value j = j + 1 'info 8 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Workbooks(FicheA).Worksheets(Feuil1).Cells(25, 2).Value End Sub
Bonjour Elhevan,
Alors la macro marche à peu près très bien sauf pour l’incrémentation
Elle crée une ligne vide avec le numéro d’incrémentation et puis la deuxième ligne avec les données et donc une deuxieme incrémentation
j'aimerais que l’incrémentation se fasse par rapport à la case d'avant qui est une ref ( dans mon cas c'est S_2016_38 la ligne remplie d'avant )
et aussi pour les dates , elles sont dans un caldenrier inserer dans des cellules du fichier A et ducoup elle se copie pas dans le fichier B pt etre qu'il faut faire un copier coller special ?
Voila merci encore !
Bonjour.
Une capture d'écran du problème d'incrémentation est-elle possible ?
Bonne journée.
Elhevan a écrit :Bonjour.
Une capture d'écran du problème d'incrémentation est-elle possible ?
Bonne journée.
Bonjour!
C'est bon ca remarche , je ne sais pas comment je n'ai plus le bug de la ligne vide
par contre le soucis de la date du calendrier qui ne se copie pas même si elle est lié à une cellule et puis l’incrémentation avec une ref precise
Si c'est bon pour la date!
il reste plus que l’incrémentation !
Pour la ref changer
"Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = i"
en :
Dim size As Integer
Dim taille As Integer
Dim ref As Integer
Dim nom As String
nom = Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value
count = InStrRev(nom, "_")
taille = Len(nom)
ref = Right(nom, taille - count)
ref = ref + 1
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Left(nom, count) & refPour la date, dans quelle case est-elle sur le fichier A "véritable" ? Si c'est bien C1 ça devrait passer '-'
Elhevan a écrit :Pour la ref changer
"Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = i"
en :
Dim size As Integer Dim taille As Integer Dim ref As Integer Dim nom As String nom = Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value count = InStrRev(nom, "_") taille = Len(nom) ref = Right(nom, taille - count) ref = ref + 1 Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Left(nom, count) & refPour la date, dans quelle case est-elle sur le fichier A "véritable" ? Si c'est bien C1 ça devrait passer '-'
Je teste merci !
en C2 j'ai changé la case dans le code
mais aussi j'ai deux autres dates dans deux cases ailleurs
Pour la reference sur le fichier déja existant c'est S_2016_38 ( le 38 c'est le chiffre actuel de la ref )
Mais ducoup le 2016 va changer en début de l'année pro, je serais obligé de re rentrer dans le code pour incrementer l'année
Il y a pas moyen de faire incrémenter par rapport à la cellule d'avant?
Parce que je suis débile, mais je me soigne
Dim size As Integer
Dim taille As Integer
Dim ref As Integer
Dim nom As String
nom = Workbooks(FicheB).Worksheets(Feuil1).Cells(i-1, j).Value
count = InStrRev(nom, "_")
taille = Len(nom)
ref = Right(nom, taille - count)
ref = ref + 1
Workbooks(FicheB).Worksheets(Feuil1).Cells(i, j).Value = Left(nom, count) & ref
Pour la reference sur le fichier déja existant c'est S_2016_38 ( le 38 c'est le chiffre actuel de la ref )
Mais ducoup le 2016 va changer en début de l'année pro, je serais obligé de re rentrer dans le code pour incrementer l'année
Il y a pas moyen de faire incrémenter par rapport à la cellule d'avant?
A l'heure actuelle ça prend S_2016_38, ça isole ce qui est après le dernier _ donc 38, ça rajoute un donc 39 et ça colle ça à ce qui est avant le dernier _ donc S_2016_. L'année prochaine tu devras remplir la première ref à la main et le reste ira tout seul.