Code VBA - Copier et coller sous conditions

BAT

XLDnaute Occasionnel
Bonjour à tous,
J'essaie en vain de contourner mes lacunes VBZ pour réussir à me faire un outils de suivi d'action.
Je bute sur un code VBA. Pourriez-vous me donner un ti' coup d'pouce !

Le code que je cherche est faire est pas facile à expliqer. Je souhaite que pour toutes les feuilles du classeur à l'exeption des feuille nommées "ADMIN", "CONSO", "CONSO2", la macro effectue les opérations suivantes pour chaque feuille :
1- copie les données des cellules M8:BV23
2- coller (collage spéciale valeur) les données copiées dans la feuille "CONSO"
3- copier ces données fraichement collées avec valeur (de la feuille "CONSO")
4- Coller (collage spéciale TRANSPOSER) les données copiées dans la feuille "CONSO2")

Pour l'étapes quatre la macro copiera d'abort en cellule A1 les données puis au fur et a mesure viendras coller les données à la suite.

Pas facile facile à imaginer donc j'ai tenté d'illustre cela par un fichier Excel! Le but est de créer de cette manière un tableau que j'exploite pour un TCD.

Merci à tous pour votre aide.

A bientôt
 

Pièces jointes

  • TEST BA.xls
    138 KB · Affichages: 115
  • TEST BA.xls
    138 KB · Affichages: 116
  • TEST BA.xls
    138 KB · Affichages: 114
D

Denis

Guest
Re : Code VBA - Copier et coller sous conditions

Bonjour bat et le Forum,
L'idéal serait déjà que tu fasse un essai de ce que tu veux avec l'assistant de macro. Nous aurons ainsi une base pour améliorer ton travail, et te conseiller.
Bon courage et A+
Denis
 

BAT

XLDnaute Occasionnel
Re : Code VBA - Copier et coller sous conditions

Bonjour Denis,
Exact, surtout que je viens de m'apercevoir qu'il était possible de faire en même un collage spéciale valeur +Transposer donc l'étape 2 et 3 n'est pas necessaire.

Voici ce que dois faire le code sauf qu'il doit être améliorer des points suivants :
- Boucle : L'opération doit se répéter pour toutes les feuilles du classeur à l'exeption des feuille nommées "ADMIN", "CONSO2",(et toutes celles que je déciderais par la suite).
- Collage "intuitif" : Ensuite pour la macro doit venir coller dans la feuille CONSO2 les données à la suite. Donc pour le résultat de la 1er feuille colée en A1 puis pour la deuxième feuille dans la 1er celulle vide en AX ....

Code:
Sheets("Feuil4").Select
    Range("M8:BV23").Select
    Selection.Copy
    Sheets("CONSO2").Select
    Range("A1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=True
Je remets le fichier Excel modifié.

Est-ce que c'est plus compréhensible (c'est super difficile d'être clair et précis dis-donc) ?

Merci par avance pour votre précieuse aide.
 

Pièces jointes

  • TEST BA.xls
    124.5 KB · Affichages: 130
  • TEST BA.xls
    124.5 KB · Affichages: 130
  • TEST BA.xls
    124.5 KB · Affichages: 137

BAT

XLDnaute Occasionnel
Re : Code VBA - Copier et coller sous conditions

J'ai repéré ce code que j'ai adapté. En revanceh je bute sur un point. Je n'arrive pas à l'adapter pour obtenir le collage spécial valeur et transposé ! Help !

Code:
Sub test2()
Dim ws As Worksheet
Dim wsdesti As Worksheet
Dim plage As Range
Dim derligne As Long

Set wsdesti = Worksheets("CONSO2")

For Each ws In Worksheets
    If ws.Name <> "CONSO2" And ws.Name <> "ADMIN" Then
        With ws.UsedRange
            Set plage = .Range("M8:BV23")
            ' Set plage = .Offset(6, 0).Resize(.Rows.Count - 6, .Columns.Count)

        End With
            derligne = wsdesti.Range("h65536").End(xlUp).Row + 0
            plage.Copy Destination:=wsdesti.Cells(derligne, 1)
    End If
Next ws

End Sub
 
Dernière édition:
D

Denis

Guest
Re : Code VBA - Copier et coller sous conditions

Re bonjour à tous
essais ceci (nontesté)

derligne = wsdesti.Range("h65536").End(xlUp).Row + 0
plage.Copy
wsdesti.Cells(derligne, 1).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Bon courage et à +
Denis
 

Si...

XLDnaute Barbatruc
Re : Code VBA - Copier et coller sous conditions

Salut

à tester en contrôlant le noms des feuilles admises :
Code:
Sub test2()
    Dim ws As Worksheet
    Dim tablo
    Dim n As Long
    With Sheets("CONSO2")
        .[A1:P186].ClearContents
        For Each ws In Worksheets
            If Left(ws.Name, 1) = "F" Then
                tablo = ws.Range("M8:BV23") '16 lignes, 62 colonnes
                .Range(Cells(1 + n, 1), Cells(62 + n, 16)) = Application.Transpose(tablo)
                n = n + 62
            End If
        Next
    End With
End Sub
 

Discussions similaires

Réponses
6
Affichages
410

Statistiques des forums

Discussions
312 294
Messages
2 086 950
Membres
103 404
dernier inscrit
sultan87