[XLS 2010] VBA récupération d'information des classeurs fermés

Mikael_D

XLDnaute Nouveau
Bonjour,

Pourriez vous m'aider svp afin que je puisse récupérer des informations automatique des classeurs fermés

Sous Excel

Cellule A1 (texte qui change toutes les semaines) dans mon exemple j'ai :
KSR 20141228 au 20150103

Cellule A2 à A?? (nom du site) dans mon exemple j'ai
ACL1
ACO1
Etc

Cellule B2 à B?? (même nombre de ligne que la colonne A) formule de calcul suivante
=A2&"\[" & A2 &" "& $A$1

Cellule C2 à C?? (même nombre de ligne que la colonne A) formule suivante
="'G:\adv_bilan\Comptabilité PV\Sites Montagne\Caisses Recettes\" &B2&".xlsm]Espèces'!$G$6"

Cellule D2 à D?? (même nombre de ligne que la colonne A) formule suivante
="'G:\adv_bilan\Comptabilité PV\Sites Montagne\Caisses Recettes\" &B2&".xlsm]Espèces'!$H$10"


J'aimerais que dans la colonne D soit récupérer les informations de la cellule C si le fichier est présent, si celui ci n'est pas présent j'aimerais avoir dans la cellule l'information suivante "Fichier manquant"

Merci d'avance de votre aide
Mikael
 
Dernière édition:

Mikael_D

XLDnaute Nouveau
Re : [XLS 2010] VBA récupération d'information des classeurs fermés

Sub Récupération_n°_bordereaux()
Dim repert As String
Dim fich As String
Dim feuil As String
Dim feuil2 As String

Application.DisplayAlerts = False

On Error GoTo err

Sheets("Récap").Select
Range("A2").Select

Do While ActiveCell.Offset.Value <> ""

repert = ActiveCell.Offset(0, 1).Value
fich = ActiveCell.Offset(0, 2).Value
feuil = ActiveCell.Offset(0, 3).Value
feuil2 = ActiveCell.Offset(0, 4).Value
ligne = ActiveCell.Row

ChDir (repert)
Workbooks.Open Filename:= _
(repert & "\" & fich)
Sheets(feuil).Select
ActiveWindow.SmallScroll Down:=-48
numden = Range("B5").Value

Windows("Récap Montagne.xlsm").Activate
ActiveCell.Offset(0, 5).Value = numden

Windows(fich).Activate
Sheets(feuil2).Select
ActiveWindow.SmallScroll Down:=-48
numden2 = Range("G6").Value
Windows("Récap Montagne.xlsm").Activate
ActiveCell.Offset(0, 6).Value = numden2


Windows(fich).Activate
numden3 = Range("K6").Value
Windows("Récap Montagne.xlsm").Activate
ActiveCell.Offset(0, 7).Value = numden3

Windows(fich).Activate
ActiveWorkbook.Saved = True
ActiveWindow.Close

GoTo Suite


err:

Select Case err.Number
Case 54: Range("F" & ligne).Value = "Fichier introuvable"
Case 76: MsgBox "Chemin incorrect"
Case Else: Range("F" & ligne).Value = "Fichier introuvable"
End Select
GoTo Suite

Suite:
ActiveCell.Offset(1, 0).Select

Loop

Application.DisplayAlerts = True

End Sub
 

Discussions similaires