copier mutiple formule fichier A dans fichier B en VBA

fredh

XLDnaute Occasionnel
Bonsoir le forum
J'ai un soucis, pour lequel je requiert vos connaissances.
J'ai un fichier maitre qui me creer des fichier "finaux". J'ai environ 3500 fichier a creer et j'en ai deja fait environ 1/3.

Le probleme est que certaine formule du fichier maitres sont fausse et donc toutes celle de mes fichiers esclaves....

Je stocke mes formule corriger dans un fichier "personl.xls" en feuille "Tabelle1" celulle "S6:U6" (elles sont fusionnez).
J'aimerai ouvrir un fichier apres l'autres rechercher et corriger les formules puis enregistrer et fermer le fichiers.
Dans un premier temps je me suis pencher sur le recherche de formule et la corection, quand cela serat regler j'ai deja une idée pour l'ouverture en serie...

Mes fichier contienne plusieur feuille dont certaines cacher.
Les formules a coriger sont toujours dans la zone "A1:Z58" et jamais dans les feuile cacher.
Certains fichier ne contienne pas de formule ....

J'ai commencer un code mais il me saute des recherches (il ne corige pas toutes les formule)

Ci joint un fichier de test avec deux boutons : un pour coriger les formule et l'autres pour remetre les fausse formule

Dans le fichier exemple une formules (avec le fond jaune) se trouve en S25, la celulle devrait afficher comme resultat "0.2" et non "0.8"....

dans le post suivant je joint le fichier "personl.xls"

Voici le code que j'utilise (il se trouve aussi dans le fichier joint)
Code:
Option Explicit
 
Sub Changer_Formule()
Dim P As Range, C As Range
Dim sh As Worksheet, Wb_Org As String, Quelle As String
Quelle = "Personl.xls"
 
For Each sh In Sheets
    If sh.Visible = True Then
        sh.Select
        On Error Resume Next    'Valide la gestion d'erreur
        Set P = sh.Range("A1:Z58").Find("Alarm", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
        :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True)
        'On Error GoTo 0     'Invalide la gestion d'erreur
        If Not P Is Nothing Then
            For Each C In P
                'C.Select
                C.Offset(0, 16).Select
                Wb_Org = ActiveWorkbook.Name
                Workbooks(Quelle).Sheets(1).Activate
                Range("S6:U6").Select
                'Application.CutCopyMode = False
                Selection.Copy
                Workbooks(Wb_Org).Activate
                ActiveSheet.Paste
            Next C
            Set P = Nothing
        End If
        On Error GoTo 0        'Invalide la gestion d'erreur
    End If
Next sh
End Sub


Une aide serait vraiment apreciable car la je ne trouve pas le bug..

Merci a tous

Amicalement
 

Pièces jointes

  • Fred_Formule.zip
    32.2 KB · Affichages: 24
Dernière édition:

fredh

XLDnaute Occasionnel
Re : copier mutiple formule fichier A dans fichier B en VBA

Code:
Sub Changer_Formule_1()
 
Dim sh As Worksheet
Dim P As Range, C As Range
 
Application.ScreenUpdating = False
    For Each sh In Sheets
        If sh.Visible = True Then
        On Error Resume Next 'Valide la gestion d'erreur
        Set P = sh.Range("A1:Z58").Find(What:="Alarm", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
            :=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, _
            SearchFormat:=False)
            'SearchFormat:=False).Activate
        On Error GoTo 0 'Invalide la gestion d'erreur
        If Not P Is Nothing Then
            sh.Activate
            For Each C In P
                [COLOR=blue]C.Offset(0, 16).Select
                Workbooks("Personl.xls").Activate
                Sheets(1).Select
                'Range("S6:U6").Select [COLOR=seagreen]'celulle fusionner[/COLOR]
                Range("S6").Select
                'Application.CutCopyMode = False [COLOR=seagreen]'oui ou non ?[/COLOR]
                Selection.Copy
                Workbooks("Fred_Formule.xls").Activate
                ActiveSheet.Paste
[/COLOR]           Next C
        Set P = Nothing
        End If
    End If
Next sh
Application.ScreenUpdating = True
End Sub

Le code saute les celulle ....

La 1er fois que je le lance il me trouve la 1er celule
la 2em fois le 2em cell
la 3em fois la 3m cell....etc

Quelqu'un aurait il une idée ?

merci et @+
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 818
Messages
2 092 376
Membres
105 381
dernier inscrit
stephan57