Aide à la modification du code VBA

Le 03/09/2022 à 04:25
Bonjour à tous, y a-t-il une solution à ce gâchis.  J'ai 100 feuilles de hakan à hakan100 comment puis-je créer un code court qui fait ce travail.Merci d'avance.

Sub JJ()

If Sheets("toutal").Range("b4") = "hakan" Then
Sheets("toutal").Range("c4") = Sheets("hakan").Range("b11")
Sheets("toutal").Range("d4") = Sheets("hakan").Range("b6")
Sheets("toutal").Range("e4") = Sheets("hakan").Range("b8")
Sheets("toutal").Range("f4") = Sheets("hakan").Range("m6")
Sheets("toutal").Range("g4") = Sheets("hakan").Range("b12")
Sheets("toutal").Range("h4") = Sheets("hakan").Range("b13")
Sheets("toutal").Range("i4") = Sheets("hakan").Range("b17")
Sheets("toutal").Range("j4") = Sheets("hakan").Range("k47")
Sheets("toutal").Range("k4") = Sheets("hakan").Range("l47")
Sheets("toutal").Range("l4") = Sheets("hakan").Range("m47")
Sheets("toutal").Range("m4") = Sheets("hakan").Range("n47")
Sheets("toutal").Range("n4") = Sheets("hakan").Range("c81")
End If
If Sheets("toutal").Range("b4") = "hakan1" Then
Sheets("toutal").Range("c4") = Sheets("hakan1").Range("b11")
Sheets("toutal").Range("d4") = Sheets("hakan1").Range("b6")
Sheets("toutal").Range("e4") = Sheets("hakan1").Range("b8")
Sheets("toutal").Range("f4") = Sheets("hakan1").Range("m6")
Sheets("toutal").Range("g4") = Sheets("hakan1").Range("b12")
Sheets("toutal").Range("h4") = Sheets("hakan1").Range("b13")
Sheets("toutal").Range("i4") = Sheets("hakan1").Range("b17")
Sheets("toutal").Range("j4") = Sheets("hakan1").Range("k47")
Sheets("toutal").Range("k4") = Sheets("hakan1").Range("l47")
Sheets("toutal").Range("l4") = Sheets("hakan1").Range("m47")
Sheets("toutal").Range("m4") = Sheets("hakan1").Range("n47")
Sheets("toutal").Range("n4") = Sheets("hakan1").Range("c81")
End If
If Sheets("toutal").Range("b4") = "hakan2" Then
Sheets("toutal").Range("c4") = Sheets("hakan2").Range("b11")
Sheets("toutal").Range("d4") = Sheets("hakan2").Range("b6")
Sheets("toutal").Range("e4") = Sheets("hakan2").Range("b8")
Sheets("toutal").Range("f4") = Sheets("hakan2").Range("m6")
Sheets("toutal").Range("g4") = Sheets("hakan2").Range("b12")
Sheets("toutal").Range("h4") = Sheets("hakan2").Range("b13")
Sheets("toutal").Range("i4") = Sheets("hakan2").Range("b17")
Sheets("toutal").Range("j4") = Sheets("hakan2").Range("k47")
Sheets("toutal").Range("k4") = Sheets("hakan2").Range("l47")
Sheets("toutal").Range("l4") = Sheets("hakan2").Range("m47")
Sheets("toutal").Range("m4") = Sheets("hakan2").Range("n47")
Sheets("toutal").Range("n4") = Sheets("hakan2").Range("c81")
End If
If Sheets("toutal").Range("b4") = "hakan3" Then
Sheets("toutal").Range("c4") = Sheets("hakan3").Range("b11")
Sheets("toutal").Range("d4") = Sheets("hakan3").Range("b6")
Sheets("toutal").Range("e4") = Sheets("hakan3").Range("b8")
Sheets("toutal").Range("f4") = Sheets("hakan3").Range("m6")
Sheets("toutal").Range("g4") = Sheets("hakan3").Range("b12")
Sheets("toutal").Range("h4") = Sheets("hakan3").Range("b13")
Sheets("toutal").Range("i4") = Sheets("hakan3").Range("b17")
Sheets("toutal").Range("j4") = Sheets("hakan3").Range("k47")
Sheets("toutal").Range("k4") = Sheets("hakan3").Range("l47")
Sheets("toutal").Range("l4") = Sheets("hakan3").Range("m47")
Sheets("toutal").Range("m4") = Sheets("hakan3").Range("n47")
Sheets("toutal").Range("n4") = Sheets("hakan3").Range("c81")
End If
End Sub
Le 03/09/2022 à 05:09

Bonjour,
Pour le principe, une procédure évènementielle :

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet
    If Target.Address = "$B$4" Then
        Me.Cells(4, 3).Resize(, 12).ClearContents
        If Not IsEmpty(Target) Then
            Set ws = Worksheets(Target.Value)
            Select Case ws.Name
                Case "toutal":
                Case Else:
                    With Me
                        .Range("C4") = ws.Range("B11")
                        .Range("D4") = ws.Range("B6")
                        .Range("E4") = ws.Range("B8")
                        .Range("F4") = ws.Range("M6")
                        .Range("G4") = ws.Range("B12")
                        .Range("H4") = ws.Range("B13")
                        .Range("I4") = ws.Range("B17")
                        .Range("J4") = ws.Range("K47")
                        .Range("K4") = ws.Range("L47")
                        .Range("L4") = ws.Range("M47")
                        .Range("M4") = ws.Range("N47")
                        .Range("N4") = ws.Range("C81")
                    End With
            End Select
        End If
    End If
End Sub
Le 03/09/2022 à 06:17

bonjour, je n'ai pas lu toute la question, mais ceci est plus court

With ws
     Me.Range("C4").Resize(, 12).Value = Array(.Range("B11").Value, .Range("B6").Value, .Range("B8").Value, .Range("M6").Value, .Range("B12").Value, .Range("B13").Value, _
                                                              .Range("B17").Value, .Range("K47").Value, .Range("L47").Value, .Range("M47").Value, .Range("N47").Value, .Range("C81").Value)
End With
Le 03/09/2022 à 06:55

Bonjour à tous,

Bon exercice mais avec un fichier, c'est plus fiable

7exo.xlsm (20.43 Ko)
Private Sub Worksheet_Change(ByVal Target As Range)
Dim j%
    If Target.Address = "$B$4" Then
'recherche onglet
            For j = 1 To Application.Sheets.Count
                If Sheets(j).Name = Target Then
                    With Sheets("toutal")
                        .Range("C4") = Sheets(j).Range("B11")
                        .Range("D4") = Sheets(j).Range("B6")
                        .Range("E4") = Sheets(j).Range("B8")
                        .Range("F4") = Sheets(j).Range("M6")
                    End With
                End If
            Next j
    End If
End Sub

Cdt

Le 03/09/2022 à 09:17

Bonjour à tous,

Sinon, il est aussi possible de mettre la formule suivante en C4 :

=INDIRECT($B$4&"!B11")

En D4, on remplacera B11 par B6.

Et ainsi de suite...

Cdlt,

Le 03/09/2022 à 12:03

Merci à tous pour vos suggestions, le problème maintenant c'est que j'ai 100 cartes au nom de hakan

Hakan

Hakan1

Hakan2... ....

Hakan100

Comment puis-je extraire des données de chaque feuille avec la condition de la valeur dans la colonne b4.Est-il possible d'implémenter la condition sur la colonne v4 à b50...par exemple, si b4 est égal à hakan, les données sont copiées à partir du hakan feuille et en même temps b5 est égal à hakan4, il est copié devant la ligne b5

Le 03/09/2022 à 12:05

Je veux dire que la condition est exécutée le long des colonnes b4 à b50

Le 03/09/2022 à 12:09

Bonjour,

J'ai le sentiment que réponse vous a déjà été donnée.

Pour une aide adaptée, vous devriez joindre un fichier représentatif du problème.

Enfin, j'ai le sentiment que vous prenez le problème à l'envers. En général, on remplit une base de données pour ensuite "appeler" les informations ailleurs (sur une feuille dédiée où on met en forme l'information brute). Là, j'ai l'impression que vous cherchez à faire l'inverse. Je pense donc qu'il faut tout refaire.

Cdlt,

Le 03/09/2022 à 13:32

Merci, il semble que je ne pouvais pas communiquer l'idée, j'ai pu obtenir ma commande par ce code, mais je veux l'appliquer à toutes les cases de la colonne b de b4:b100 pour obtenir plus d'un résultat au total feuille

Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim ws As Worksheet If Target.Address = "$B$4" Then Me.Cells(4, 3).Resize(, 12).ClearContents If Not IsEmpty(Target) Then Set ws = Worksheets(Target.Value) Select Case ws.Name Case "toutal": Case Else: With Me .Range("C4") = ws.Range("B11") .Range("D4") = ws.Range("B6") .Range("E4") = ws.Range("B8") .Range("F4") = ws.Range("M6") .Range("G4") = ws.Range("B12") .Range("H4") = ws.Range("B13") .Range("I4") = ws.Range("B17") .Range("J4") = ws.Range("K47") .Range("K4") = ws.Range("L47") .Range("L4") = ws.Range("M47") .Range("M4") = ws.Range("N47") .Range("N4") = ws.Range("C81") End With End Select End If End If End Sub
Le 03/09/2022 à 15:47

Dans ce cas, une procédure évènementielle ne convient pas. Il faudrait, par VBA, une boucle sur l'ensemble de la colonne B mais vous ne vous êtes pas bien exprimé.

Cependant, la fonction INDIRECT convient tout à fait.

Mais votre réel problème, c'est que vous ne tenez pas compte des réponses qui vous sont données. Pour une aide adaptée, vous devriez joindre un fichier représentatif du problème.

Enfin, je me répète mais je pense que vous prenez le problème à l'envers.

Je parie que votre fichier ne nécessite que 2 feuilles :

- une base de 13 colonnes avec une ligne par "carte" (Hakan1, ...) et les infos correspondantes dans les 12 autres colonnes.

- un onglet de restitution des informations (mises en forme comme vous le désirez) dans lequel la seule variable est la carte. Alors, à l'aide d'un RECHERCHEV ou INDEX EQUIV, vous obtenez toutes les infos qui s'y rattachent.

Cdlt,

Le 03/09/2022 à 16:24

Bonjour Arwasoha, Le Forum,

Nul besoin de VBA, sauf si le fichier a trop de données. La solution présentée par 3GB est suffisante.

Voici en retour. Merci à Fronck pour la fourniture d'un fichier.

4exobis.xlsx (13.30 Ko)

Inscris seulement ton numéro de feuille Hanka en colonne B. Et les formules feront le reste.

Le 04/09/2022 à 02:06

Merci à tous pour votre attention et le suivi de ma demande, c'est la solution la plus adaptée pour moi

=INDIRECT($B$4&"!B11")

Rechercher des sujets similaires à "aide modification code vba"