Récupérer des données d'un excel à un autre
BAKIdu17
Messages postés
4
Date d'inscription
Statut
Membre
Dernière intervention
-
danielc0 Messages postés 1857 Date d'inscription Statut Membre Dernière intervention -
danielc0 Messages postés 1857 Date d'inscription Statut Membre Dernière intervention -
Bonjour tout le monde,
Je souhaite récupérer des données d'un excel à un autre.
Pour cela quelqu'un m'a aider pour un programme macro avec bouton.
je vais vous le mettre mais j'ai un code erreur pouvez-vous m'aider à résoudre le problème ?
Le but de cette macro est de récupérer des données d'un autre excel par rapport à une colonne en particulier. Soit il modifie la ligne lorsque qu'elle change soit il ajoute la ligne lorsqu'elle n'existe pas.
Merci d'avance.
Sub traiter()
Dim bb, a&, i&, n&, cc, fin&, d&, col&
With Feuil1
bb = .Range("A2:AP" & .Range("A" & Rows.Count).End(3).Row)
End With
ReDim cc(1 To UBound(aa), 1 To UBound(aa, 2))
For i = 1 To UBound(aa)
For a = 1 To UBound(bb)
If aa(i, 1) = bb(a, 1) Then
For col = 3 To UBound(bb, 2)
If aa(i, col) <> bb(a, col) Then bb(a, col) = aa(i, col)
Next col
GoTo 1
End If
Next a
n = n + 1
For d = 1 To UBound(bb, 2)
cc(n, d) = aa(i, d)
Next d
cc(n, 2) = cc(n, 3) & "-" & cc(n, 4) & "-" & cc(n, 5) & "-" & cc(n, 8) & "-" & cc(n, 9) & "-" & cc(n, 11)
1 Next i
With Feuil1
.Cells(3, 1).Resize(UBound(bb), UBound(bb, 2)).FormulaLocal = bb
fin = .Range("A" & Rows.Count).End(3).Row + 1
.Cells(fin, 1) = 1
.Cells(fin, 1).Resize(UBound(cc), UBound(cc, 2)).FormulaLocal = cc( la ligne en erreur)
Call test
End With
End Sub
BAKIdu17
Je souhaite récupérer des données d'un excel à un autre.
Pour cela quelqu'un m'a aider pour un programme macro avec bouton.
je vais vous le mettre mais j'ai un code erreur pouvez-vous m'aider à résoudre le problème ?
Le but de cette macro est de récupérer des données d'un autre excel par rapport à une colonne en particulier. Soit il modifie la ligne lorsque qu'elle change soit il ajoute la ligne lorsqu'elle n'existe pas.
Merci d'avance.
Sub traiter()
Dim bb, a&, i&, n&, cc, fin&, d&, col&
With Feuil1
bb = .Range("A2:AP" & .Range("A" & Rows.Count).End(3).Row)
End With
ReDim cc(1 To UBound(aa), 1 To UBound(aa, 2))
For i = 1 To UBound(aa)
For a = 1 To UBound(bb)
If aa(i, 1) = bb(a, 1) Then
For col = 3 To UBound(bb, 2)
If aa(i, col) <> bb(a, col) Then bb(a, col) = aa(i, col)
Next col
GoTo 1
End If
Next a
n = n + 1
For d = 1 To UBound(bb, 2)
cc(n, d) = aa(i, d)
Next d
cc(n, 2) = cc(n, 3) & "-" & cc(n, 4) & "-" & cc(n, 5) & "-" & cc(n, 8) & "-" & cc(n, 9) & "-" & cc(n, 11)
1 Next i
With Feuil1
.Cells(3, 1).Resize(UBound(bb), UBound(bb, 2)).FormulaLocal = bb
fin = .Range("A" & Rows.Count).End(3).Row + 1
.Cells(fin, 1) = 1
.Cells(fin, 1).Resize(UBound(cc), UBound(cc, 2)).FormulaLocal = cc( la ligne en erreur)
Call test
End With
End Sub
BAKIdu17
A voir également:
- Récupérer des données d'un excel à un autre
- Comment recuperer un message supprimé sur whatsapp - Guide
- Trier des données excel - Guide
- Liste déroulante excel - Guide
- Comment récupérer un compte facebook piraté - Guide
- Word et excel gratuit - Guide
Je ne peux pas partager mes fichiers sinon je l'aurais déjà fais.
Je peux donner un exemple si vous voulez ?
BAKI
Daniel
Voici les fichiers
https://mon-partage.fr/f/pFqfBocT/
https://mon-partage.fr/f/5Laei2Hl/
Voici le programme :
Option Explicit
Public aa
Sub importer()
Dim fd As Object, fichier$, wbks As Workbook, m&, x$, y&, f As Range, fin&
Dim adr, a, mem$, rep, nom$
Application.ScreenUpdating = 1
Set fd = Application.FileDialog(1)
With fd
fichier = ThisWorkbook.Path: m = Len(fichier)
.Title = "Choisissez le Fichier du quel vous Souhaitez Importer les Données"
.InitialFileName = fichier & "\Fichier à Importer\"
.ButtonName = "Importer"
.Filters.Clear
.Filters.Add "Fichier Excel", "*.xlsm"
.AllowMultiSelect = False
If .Show <> 0 Then
nom = .SelectedItems(1)
a = Split(nom, "\"): mem = a(UBound(a))
mem = Mid(mem, 1, Len(mem) - 4)
Set wbks = Workbooks.Open(nom, 0)
aa = wbks.ActiveSheet.Range("A1:AP" & wbks.ActiveSheet.Range("A" & Rows.Count).End(3).Row)
wbks.Close 0
Call traiter
Else
MsgBox "Vous n'avez aucun Fichier Planning Equipe PMC, ou vous n'avez Séléctionné aucun fichier!!!", , "Manque de Fichier": Exit Sub
End If
End With
End Sub
Sub traiter()
Dim bb, a&, i&, n&, cc, fin&, d&, col&
With Feuil1
bb = .Range("A2:AP" & .Range("A" & Rows.Count).End(3).Row)
End With
ReDim cc(1 To UBound(aa), 1 To UBound(aa, 2))
For i = 1 To UBound(aa)
For a = 1 To UBound(bb)
If aa(i, 1) = bb(a, 1) Then
For col = 3 To UBound(bb, 2)
If aa(i, col) <> bb(a, col) Then bb(a, col) = aa(i, col)
Next col
GoTo 1
End If
Next a
n = n + 1
For d = 1 To UBound(bb, 2)
cc(n, d) = aa(i, d)
Next d
cc(n, 2) = cc(n, 3) & "-" & cc(n, 4) & "-" & cc(n, 5) & "-" & cc(n, 8) & "-" & cc(n, 9) & "-" & cc(n, 11)
1 Next i
With Feuil1
.Cells(3, 1).Resize(UBound(bb), UBound(bb, 2)).FormulaLocal = bb
fin = .Range("A" & Rows.Count).End(3).Row + 1
.Cells(fin, 1) = 1
.Cells(fin, 1).Resize(UBound(cc), UBound(cc, 2)).FormulaLocal = cc (ligne en erreur)
Call test
End With
End Sub
Sub test()
Dim fin&, i&
Application.ScreenUpdating = 0
With Feuil1
fin = .Range("A" & Rows.Count).End(3).Row
For i = fin To 3 Step -1
If .Cells(i, 1) = "" Then .Rows(i).Delete
Next i
End With
End Sub
Merci d'avance.
BAKI
La macro s'exécute correctement, sans plantage, ici.
Daniel
Comme je l'indique sur le message avec le programme j'ai une erreur à la ligne en gras et je comprend pas pourquoi.
Sur mon projet réel j'ai beaucoup plus de données que ça mais je ne comprend pas l'erreur.
Vous ne voyez vraiment pas ce qui pourrai clocher ?
Merci d'avance.
BAKI