Exportation base dans plusieurs fichiers et récupération dans une base
Excuse moi j'avais oublié de supprimer les lignes vides.
Pour être clair j'aimerai extraire selon la colonne 13 afin chaque activité qui complétera son information
Et refaire la base au propre, merci. Afin d'éviter que les informations principales soient modifiées par erreur.
Merci
Ajoute le complément de macro ... (déjà signalé 2 fois)
Peux tu me signaler avec un exemple pour que je puisse extraire sur ma clef USB. Maintenant je recopie la macro pour rapatrier les infos des différents services.
Je recopie les modules ou les macros?
Merci
Cordialement
Tout le (nouveau) module export
Sub fractionner()
Dim Tbl As Variant, data As Variant, i%
Dim dico1 As Object, cle1 As Variant, result1 As Variant, prov1 As Variant
Dim xl As Excel.Application, wb As Excel.Workbook
Dim critere%
critere = 13
data = ActiveSheet.Cells(1, 1).CurrentRegion
Set dico1 = CreateObject("Scripting.Dictionary")
For i = LBound(data) + 1 To UBound(data) ' hors en-tête
dico1(data(i, critere)) = ""
Next
Set xl = CreateObject("Excel.Application")
xl.SheetsInNewWorkbook = 1
prov1 = data(1, critere)
For Each cle1 In dico1.Keys
Set wb = xl.Workbooks.Add
data(1, critere) = cle1 ' pour emmener aussi l'en-tête
result1 = filtreArray(data, critere, cle1)
wb.Sheets(1).Cells(1, 1).Resize(UBound(result1, 1), UBound(result1, 2)) = result1
wb.Sheets(1).Cells(1, critere).Value = prov1
wb.SaveAs (ThisWorkbook.Path & "\" & cle1 & ".xlsx")
wb.Close
Set wb = Nothing
Next
xl.Quit
Set xl = Nothing
MsgBox "Terminé !"
End Sub
Function filtreArray(Tbl, col, param)
Dim i%, j%, k%, n%
For i = 1 To UBound(Tbl)
If Tbl(i, col) = param Then n = n + 1
Next i
Dim temp: ReDim temp(1 To n, 1 To UBound(Tbl, 2))
j = 0
For i = 1 To UBound(Tbl)
If Tbl(i, col) = param Then
j = j + 1
For k = 1 To UBound(Tbl, 2)
temp(j, k) = Tbl(i, k)
Next k
End If
Next i
filtreArray = temp
End FunctionBonjour,
J'ai toujours le même message qu'hier j'ai contrôlé dans outils références j ai les mêmes cases que toi de cocher?
pour la sauvegarde sur ma disquette
wb.SaveAs (ThisWorkbook.Path & "\" & cle1 & "F:.xlsx") est ce exacte
wb.SaveAs ("F:" & cle1 & ".xlsx")Est-ce que mon fichier fonctionne chez toi ? si oui recopie toutes les données sur ce fichier.
Bonjour,
Encore moi, dans ma première colonne mon formatage est en nombre lors de l'extraction est en standard de ce fait le numéro saisie est par exemple 1,666666+12
Et à la fin de l'extraction j 'ai la fenêtre 400 qui s'ouvre
Merci encore
Cordialement
Fais un essai en exécution pas à pas (Touche F8)
Donne la ligne du code qui produit l'erreur 400
Ou donne ton fichier (si besoin en mp)
re Bonjour
A première vue il me créer un 5 classeur, sinon cela dispatche bien selon les codes tu pourras constater que pour moi il ne recopie pas dans le bon formatage.
Te transmettre le fichier en mp c'est quoi, dans mon fichier il y a des données confidentielles.
Merci encore
re Bonjour
A première vue il me créer un 5 classeur, sinon cela dispatche bien selon les codes tu pourras constater que pour moi il ne recopie pas dans le bon formatage.
Où est ton modèle ?
Bonjour
Dans ce cas tu crées un modèle ...Et si c'est pas trop demandé comment faire afin pour que les formats soient identiques à la base aussi en chiffre que le paramètre de largeur colonnes et couleurs.
voir aussi page suivante !
Un peu plus de rigueur ...
depuis le 30 mars tu travailles et tu me fais travailler avec ce fichier
Re,
Voici mon fichier avec la macro avec la laquelle je rencontre également un soucis.
De plus peux tu me donner un exemple pour la sauvegarde exemple sur ma disquette, afin que je puisse modifier par la suite
Merci
sans tenir compte du post fait le 29 mars
Bonjour
Dans ce cas tu crées un modèle ...Et si c'est pas trop demandé comment faire afin pour que les formats soient identiques à la base aussi en chiffre que le paramètre de largeur colonnes et couleurs.
Re,
Désolé mais je pensais que c'était une étape différente, que je devais résoudre d'abord l'extraction, que l'autre macro correspondait à la reconstitution de la base
Merci de patience
je n'y comprends plus rien
Dès lors que tu m'as demandé que les formats soient les mêmes, j'ai créé cette macro https://forum.excel-pratique.com/viewtopic.php?p=852505#p852505 qui, oui, remplace la précédente avec les exemples que j'y ai attachés.
Reprends donc ton projet du début ... quoique je vais te le faire.
Pourquoi
Y a t il une feuille 2 maintenant
1- comment s'appelle ce deuxième fichier ? oui c'est vrai j'avais mis le terme anglais
2- as-tu ouvert ce fichier ? a quoi te fait-il penser ? quelle est sa forme ?
3- as-tu chargé les 2 fichiers (dans le même dossier) et fait tourner la macro ?
Bonsoir,
merci cela fonctionne,
Il attend que je lui communique le chemin, une fois que je l'aurai recopié sur mon PC est il possible de lui donner qu'il ne s'arrête plus.
Par contre il me créer un nouveau fichier du même nom que la base Analyse dossiers QW et correspondant au modèle
Avec mes excuses je ne m'étais pas rendu compte que c'était une modification de la première macro
Pour reconsolider la base j'utilise la macro rattacher à
Compiler les fichiers en retour
Je reprends demain
Merci encore, cordialement
Il attend que je lui communique le chemin, une fois que je l'aurai recopié sur mon PC est il possible de lui donner qu'il ne s'arrête plus.
Dans ce cas, remplace ceci par :
Set Repertoire = Application.FileDialog(msoFileDialogFolderPicker)
Application.FileDialog(msoFileDialogFolderPicker).Title = "Choix du répertoire de stockage des fichiers générés"
Repertoire.Show
If Repertoire.SelectedItems.Count = 0 Then Exit Sub
MonRepertoire = Repertoire.SelectedItems(1)par
MonRepertoire = "C:\mon_repertoire_ici"