Créer un onglet en concatenant plusieurs plages de plusieurs ongletsRésolu

Question

Bonjour,



Je d&#233;bute en programmation VBA, je cherche de l'aide pour terminer mon fichier .xls de gestion du mat&#233;riel.



J'ai un fichier avec un onglet par secteur, chaque onglet &#224; la m&#234;me
structure. Chaque onglet contient  tous le  mat&#233;riel de son
secteur, l'emplacement et la quantit&#233;, par cat&#233;gorie.



Je voudrais cr&#233;er une liste r&#233;capitulative de tout le mat&#233;riel
emplacement et quantit&#233;. Mais un simple copier coller ne suffit pas car
je ne veux pas des titres et sous-titres ni des lignes vides.



Voila la structure de mon tableau

Chaque onglet porte le nom du Service:

col A:A : Titre (Les titres sont fixes qu'il y ai du mat&#233;riel ou pas)

col B:B : Sous-titre(De m&#234;me que pour les titres)

col C:C : Nom du Mat&#233;riel ou Pas d'&#233;quipement

col D:D : quantit&#233;

col E:E : emplacement



Je voudrais cr&#233;er une fonction qui copie en colonne dans un nouvel onglet 

col A:A: Service

col B:B : Nom du mat&#233;riel sans les lignes de titre et de sous-titre ni les "Pas d'&#233;quipement"

col C:C : Quantit&#233;

col D:D: Emplacement



Si vous avez un petit programme qui fasse quelque chose d'&#233;quivalent, ca m'interesse. Ou un sch&#233;ma directeur...



Je precise que je ne connais pas toutes les fonctions VBA d'ecxel.



Merci d'avance


 Bandine

Tuning Max · Accepted Answer

Hummm! Ca aurait été plus simple et moins risqué pour l'intégrité de tes données si tu étais passé par une petite base Access. Enfin je vais voir si j'ai pas une petite fonction que je pourrais adapter.
Je te tiens au courant

bandine · Answer

Je te remercie, mon principal probl&#232; c'est que j'ai pas Access et pas
de possibilit&#233; de l'installer et en plus je sais pas m'en servir.



J'esp&#232;re que tu pourras m'aider :D

 Bandine

Tuning Max · Answer

Bon nous y voilà, j'ai récupéré une fonction que j'avais initialement écrite pour supprimer de mes listes des lignes et des colonnes en fonction de différents paramètres.
J'espère que c'est ce dont tu avais besoin

Sub traitement()
Dim str As String, cell As Range, Name As String, wbook As Workbook, ws As Worksheet, sheet As Sheets
Dim i As Integer, s As Integer, j As Integer, wsName As String, temp As String


s = 2
str = "Pas d'équipement"
wsName = ActiveWorkbook.Name
' création d'un classeur temporaire
Set wbook = Workbooks.Add
wbook.Sheets("Feuil1").Name = "Resume"
temp = wbook.Name

' re-positionne le curseur sur notre classeur
    For Each ws In Worksheets
        Name = ws.Name
        Workbooks(wsName).Worksheets(Name).Activate
        ws.Columns("A:A").Select
        Selection.Insert Shift:=xlToRight
        Range("A1").Select
        ActiveCell.FormulaR1C1 = "Service"
        For i = 2 To 100
            For Each cell In Worksheets(Name).Range("D" & i & ":D" & i)
                If Not cell.Value2 = "" Then
                    If cell.Value <> str Then
                        Worksheets(Name).Select
                        Range("A" & i).Select
                        ActiveCell.FormulaR1C1 = Name
                        Rows(i).Select
                        Selection.Copy
                        For j = s To s
                            ActiveSheet.Paste Destination:=wbook.Worksheets("Resume").Rows(j)
                            s = j + 1
                        Next j
                    End If
                End If
            Next cell
        Next i
        ' suprime la colonne précédement créé
        ws.Columns("A:A").Select
        Selection.Delete
    Next ws
    ' Création de la feuille de Résumé
    Workbooks(wsName).Sheets.Add
    Sheets(ActiveSheet.Name).Name = "Resume"
    Worksheets("Resume").Move Before:=Worksheets.Item(1)
   
' re-positionne le curseur sur le classeur temporaire
    Workbooks(temp).Activate
    wbook.Worksheets("Resume").Select
    Cells.Select
    Selection.Copy
    Workbooks(wsName).Worksheets("Resume").Activate
        ActiveSheet.Paste
    With Worksheets("Resume")
                            .Range("A1").Select
                            ActiveCell.FormulaR1C1 = "service"
                            .Range("B1").Select
                            ActiveCell.FormulaR1C1 = "Titre"
                            .Range("C1").Select
                            ActiveCell.FormulaR1C1 = "Sous-Titre"
                            .Range("D1").Select
                            ActiveCell.FormulaR1C1 = "Name"
                            .Range("E1").Select
                            ActiveCell.FormulaR1C1 = "Quantite"
                            .Range("F1").Select
                            ActiveCell.FormulaR1C1 = "Emplacement"
                            .Columns("B:B").Delete
                            .Columns("B:B").Delete
    End With
' Supprime le classeur temporaire Quantite
    wbook.Close SaveChanges:=False

End Sub

bandine · Answer

Merci beaucoup je vais &#233;tudier ca tr&#232;s vite.


 Bandine

Tuning Max · Answer

Normalement je l'ai modifier de façon a ce qu'elle correspondent a tes besoins

bandine · Answer

Merci Merci Merci!!!



C'est parfait ca tourne au poil, et ca m'a permis de comprendre la
philosophie de ce language. Je vai meme lui mettre des extensions.



:smile: 

 Bandine

Créer un onglet en concatenant plusieurs plages de plusieurs onglets

6 réponses

Discussions similaires