[CHERCHE] Macro pour controler/modifier
Résolu/Fermé
A voir également:
- [CHERCHE] Macro pour controler/modifier
- Modifier pdf - Guide
- Macro logiciel - Télécharger - Organisation
- Modifier liste déroulante excel - Guide
- Modifier extension fichier - Guide
- Macro recorder - Télécharger - Confidentialité
2 réponses
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 mars 2023
2 712
Modifié par pijaku le 17/10/2011 à 12:15
Modifié par pijaku le 17/10/2011 à 12:15
Re-
Tu n'as que 3 classeurs concernés par cet Import-export de date?
Le dossier contenant ces 3 classeurs contient-il d'autres fichiers? classeurs?
Ces classeurs ont tous en cellule A1 une date. Cellule A1 ok, mais de qu'elle feuille? les noms de ces feuilles sont ils identiques dans les 3 classeurs??
Cordialement,
Franck P
Tu n'as que 3 classeurs concernés par cet Import-export de date?
Le dossier contenant ces 3 classeurs contient-il d'autres fichiers? classeurs?
Ces classeurs ont tous en cellule A1 une date. Cellule A1 ok, mais de qu'elle feuille? les noms de ces feuilles sont ils identiques dans les 3 classeurs??
Cordialement,
Franck P
Bonjour,
Le dossier peut contenir plus d'une centaine de classeur en fonction de l'affaire, tous identiques dans leur structure. la date se trouve en A1 sur la feuil1.
Si cela marche je me plongerai dedans pour l'adapter mais si déjà ca fonctionne, ce serai vraiment super!
Si tu as besoin d'autres infos n'hésite pas, je surveille le thread.
Merci pour l'attention portée a mon problème en tout cas
Bilou
Le dossier peut contenir plus d'une centaine de classeur en fonction de l'affaire, tous identiques dans leur structure. la date se trouve en A1 sur la feuil1.
Si cela marche je me plongerai dedans pour l'adapter mais si déjà ca fonctionne, ce serai vraiment super!
Si tu as besoin d'autres infos n'hésite pas, je surveille le thread.
Merci pour l'attention portée a mon problème en tout cas
Bilou
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 mars 2023
2 712
17 oct. 2011 à 15:09
17 oct. 2011 à 15:09
S'agit-il toujours du même répertoire?
pijaku
Messages postés
12263
Date d'inscription
jeudi 15 mai 2008
Statut
Modérateur
Dernière intervention
15 mars 2023
2 712
17 oct. 2011 à 16:12
17 oct. 2011 à 16:12
Bon alors :
Tu ouvres ce classeur.
Pour "importer" tes dates : ALT+F8 choix : ImporterDates
Pour "exporter" tes dates : ALT+F8 choix : ExporterDates
Les codes :
Tu ouvres ce classeur.
Pour "importer" tes dates : ALT+F8 choix : ImporterDates
Pour "exporter" tes dates : ALT+F8 choix : ExporterDates
Les codes :
Option Explicit
Sub ImporterDates()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, fichier As String
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un répertoire", &H1&)
If objFolder Is Nothing Then
MsgBox "Abandon opérateur", vbCritical, "Annulation"
Else
Columns(1).NumberFormat = "m/d/yyyy"
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & "\"
[B1] = Chemin
fichier = Dir(Chemin & "*.xls")
Do While Len(fichier) > 0
ThisWorkbook.Names.Add "Plage", _
RefersTo:="='" & Chemin & "[" & fichier & "]Feuil1'!$A$1"
With Sheets("Feuil2")
.[A1] = "=Plage"
.[A1].Copy
Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(0, 1) = fichier
End With
fichier = Dir()
Loop
End If
End Sub
Sub ExporterDates()
Dim Chemin As String, fichier As String
Dim maDate As Date
Dim Lign As Long, DrLig As Long
Application.ScreenUpdating = False
With Sheets("Feuil1")
DrLig = .Range("A" & Rows.Count).End(xlUp).Row
For Lign = 2 To DrLig
maDate = .Cells(Lign, 1).Value
If Not IsDate(maDate) Then
MsgBox "Format de date incorrecte à la ligne : " & Lign
Exit Sub
End If
Chemin = [B1]
fichier = .Cells(Lign, 2).Value
Workbooks.Open Chemin & fichier
With ActiveWorkbook
.Sheets("Feuil1").Range("A1") = CDate(maDate)
.Save
.Close
End With
Next
End With
Application.ScreenUpdating = True
End Sub
Rebonjour,
C'est impeccable, ça marche du tonnerre et dans les deux sens, je vais y mettre un peu le nez pour voir comment lui faire récupérer d'autres cellules sous le même principe et se sera exactement comme je le voulais.
Un grand grand merci pour ton aide pijaku, grâce a toi je vais gagner un temps fou et j'aurais un vrai visu sur mes tableaux de rendus.
merci encore!
Bilou
C'est impeccable, ça marche du tonnerre et dans les deux sens, je vais y mettre un peu le nez pour voir comment lui faire récupérer d'autres cellules sous le même principe et se sera exactement comme je le voulais.
Un grand grand merci pour ton aide pijaku, grâce a toi je vais gagner un temps fou et j'aurais un vrai visu sur mes tableaux de rendus.
merci encore!
Bilou