Bonjour le Forum!
J'avais crée une discussion pour importer et transférer les données automatiquement via VBA, et suite à des recherches dans le forum, j'ai réussi à combiner les différentes solutions pour résoudre mon problème.
Par contre, j'ai rencontré deux problèmes:
1. Le transfert de données automatisé fonctionne bien, mais je n'ai pas le bon format. Par exemple, les données en date sont transférées en Texte (colonne H, I, J, K).
2. Le temps d'exécution est long!, ça me prend plus de 2 mins pour ce tableau de test, mais le fichier que je dois travailler peut avoir plus de milliers de lignes. Je ne veut pas passer des heures pour faire le transfert. SVP! Help!
Voici le code que j'ai utilisé:
Pourriez-vous svp m'aider à améliorer le code ? Voici la capture d'écran une fois que j'ai fait le transfert. J'aimerais que les lignes transférées 28 à 32 aient le même format que les autres lignes. Et je voudrais réduire le temps d'exécution de transfert.
Je vous remercie énormément!
J'avais crée une discussion pour importer et transférer les données automatiquement via VBA, et suite à des recherches dans le forum, j'ai réussi à combiner les différentes solutions pour résoudre mon problème.
Par contre, j'ai rencontré deux problèmes:
1. Le transfert de données automatisé fonctionne bien, mais je n'ai pas le bon format. Par exemple, les données en date sont transférées en Texte (colonne H, I, J, K).
2. Le temps d'exécution est long!, ça me prend plus de 2 mins pour ce tableau de test, mais le fichier que je dois travailler peut avoir plus de milliers de lignes. Je ne veut pas passer des heures pour faire le transfert. SVP! Help!
Voici le code que j'ai utilisé:
VB:
Sub Importer()
Dim nom$, WBKSource As Workbook
With Application.FileDialog(msoFileDialogOpen)
.Title = "Veuillez sélectionner le fichier"
.Filters.Clear
.Filters.Add "RECAP", "*.xlsX*, *.Xlsm*, *.Xls*"
.AllowMultiSelect = False
If .Show <> 0 Then
nom = .SelectedItems(1)
Set WBKSource = Workbooks.Open(nom)
With WBKSource
.ActiveSheet.Copy Before:=ThisWorkbook.Sheets(1)
.Close False
End With
Else
MsgBox "Aucun fichier sélectionné": Exit Sub
End If
End With
End Sub
Sub Transférer()
Application.ScreenUpdating = False
DL1 = Sheets("Gantt Chart").Range("A6000").End(xlUp).Row
DL2 = Sheets("Gantt Chart (2)").Range("A6000").End(xlUp).Row
Set F = Sheets("Gantt Chart (2)")
With Sheets("Gantt Chart")
For L = 5 To DL2
If Application.CountIf(.Range("AA:AA"), F.Cells(L, "AA")) = 0 Then ' Le code n'existe pas
DL1 = DL1 + 1 ' Incrément N° ligne de transfert
Copie DL1, L
Else
Lx = Application.Match(F.Cells(L, "AA"), .Range("AA:AA"), 0) ' Ligne où se trouve le code
Copie Lx, L
End If
Next L
End With
End Sub
Sub Copie(Li1, Li2) ' Transfert cellules
Set F = Sheets("Gantt Chart (2)")
With Sheets("Gantt Chart")
.Cells(Li1, "A") = F.Cells(Li2, "A")
.Cells(Li1, "B") = F.Cells(Li2, "B")
.Cells(Li1, "C") = F.Cells(Li2, "C")
.Cells(Li1, "D") = F.Cells(Li2, "D")
.Cells(Li1, "E") = F.Cells(Li2, "E")
.Cells(Li1, "F") = F.Cells(Li2, "F")
.Cells(Li1, "G") = F.Cells(Li2, "G")
.Cells(Li1, "H") = F.Cells(Li2, "H")
.Cells(Li1, "I") = F.Cells(Li2, "I")
.Cells(Li1, "J") = F.Cells(Li2, "J")
.Cells(Li1, "K") = F.Cells(Li2, "K")
.Cells(Li1, "L") = F.Cells(Li2, "L")
.Cells(Li1, "M") = F.Cells(Li2, "M")
.Cells(Li1, "N") = F.Cells(Li2, "N")
.Cells(Li1, "Z") = F.Cells(Li2, "Z")
.Cells(Li1, "AA") = F.Cells(Li2, "AA")
End With
End SubPourriez-vous svp m'aider à améliorer le code ? Voici la capture d'écran une fois que j'ai fait le transfert. J'aimerais que les lignes transférées 28 à 32 aient le même format que les autres lignes. Et je voudrais réduire le temps d'exécution de transfert.
Je vous remercie énormément!
Dernière édition: