Distribution des données intelligente

kariboox

XLDnaute Nouveau
Bonjour les amis d'excel-download!
Tout d'abord mes meilleurs voeux pour cette année 2015!

Voila, j'arrive à la limite de mes compétences en VBA Excel sur le document ci-joint.
Il s'agit de ranger des données issues du logiciel de calcul des lignes électriques, afin qu'elles soient présentables pour le boss.

1) J'essaie de lister les supports (col. B de l'onglet MTL) dans l'onglet FR-PYLON en colonne A sans répétition, ensuite de remplir les colonnes B à H en fonction du "N°SUPPORT".

2) Je voudrais renseigner en colonne I le "Matériel de Conducteur" et en J les matériels "Matériel de CDG" tout en les concaténant avec leurs quantités respectives (onglet MTL, col. E), et en les concaténant autant de fois qu'il se rencontrent par support.

Si quelqu'un pouvait m'éclairer sur le sujet ce serait fabuleux!

En vous remerciant d'avance
fred

Voici le code de ma macro (je pense qu'il est un peu balourd)
Code:
Sub MEFpylon()
 
Application.ScreenUpdating = False

'Données d'entrée
Worksheets("PYL").Select
Range(Cells(3, 2), Cells(3, 2).End(xlDown)).Select
nbsupport = WorksheetFunction.CountA(Range(Cells(3, 2), Cells(3, 2).End(xlDown)))

      Dim Z1, Z2, Z3, Z4, Z5, Z6, Z7, MaPlageMultiZone As Range
      Worksheets("PYL").Select
      Range("B3").Select
      ActiveCell.End(xlDown).Select
      
      zone1 = ActiveCell.Address
      
      Selection.Offset(0, 2).Select
      Zone2 = ActiveCell.Address
    
      Selection.Offset(0, 2).Select
      Zone3 = ActiveCell.Address
     
      Selection.Offset(0, 3).Select
      Zone4 = ActiveCell.Address
      
     Selection.Offset(0, 2).Select
      Zone5 = ActiveCell.Address
      
     Selection.Offset(0, 1).Select
      Zone6 = ActiveCell.Address
     
     Selection.Offset(0, 2).Select
      Zone7 = ActiveCell.Address
     
     Selection.Offset(0, 5).Select
      Zone8 = ActiveCell.Address
       
      Set Z1 = Range("B3", zone1)
      Set Z2 = Range("d3", Zone2)
      Set Z3 = Range("f3", Zone3)
      Set Z4 = Range("i3", Zone4)
      Set Z5 = Range("k3", Zone5)
      Set Z6 = Range("l3", Zone6)
      Set Z7 = Range("n3", Zone7)
      Set Z8 = Range("s3", Zone8)
      Set MaPlageMultiZone = Union(Z1, Z2, Z3, Z4, Z5, Z6, Z7, Z8)

Z1.Select
  Selection.Copy
   Sheets("FR-PYLON").Select
     Range("A13").Select
    ActiveSheet.Paste
      Worksheets("PYL").Select
      
  Z7.Select
  Selection.Copy
  Sheets("FR-PYLON").Select
  Range("B13").Select
  ActiveSheet.Paste
  Worksheets("PYL").Select
    
  Z6.Select
  Selection.Copy
  Sheets("FR-PYLON").Select
  Range("c13").Select
  ActiveSheet.Paste
  Worksheets("PYL").Select
    
  Z2.Select
  Selection.Copy
  Sheets("FR-PYLON").Select
  Range("e13").Select
  ActiveSheet.Paste
  Worksheets("PYL").Select
  
  Z4.Select
  Selection.Copy
  Sheets("FR-PYLON").Select
  Range("g13").Select
  ActiveSheet.Paste
  Worksheets("PYL").Select

  Z5.Select
  Selection.Copy
  Sheets("FR-PYLON").Select
  Range("f13").Select
  ActiveSheet.Paste
  Worksheets("PYL").Select
    
  Z3.Select
  Selection.Copy
  Sheets("FR-PYLON").Select
  Range("d13").Select
  ActiveSheet.Paste
  Worksheets("PYL").Select
    
  Z8.Select
  Selection.Copy
  Sheets("FR-PYLON").Select
  Range("h13").Select
  ActiveSheet.Paste
   
  x = 13
  Do While Cells(x, 2).Value <> ""
  Cells(x, 2) = Right(Cells(x, 2).Value, Len(Cells(x, 2).Value) - InStrRev(Cells(x, 2).Value, "\", -1, 1))
  x = x + 1
  Loop

Sheets("PYL").Select

  x = 3
  Do While Sheets("PYL").Cells(x, 2).Value <> ""
  Sheets("PYL").Select
  REP = Cells(x, 2).Value
  Sheets("MTL").Select
  
  Set R = Range(Cells(2, 2), Cells(2, 2).End(xlDown)).Find(REP, LookAt:=xlWhole)
  
   Sheets("MTL").Select
 
  Range(R.Address).Offset(0, 1).Select
  
 
  Selection.Copy
  
  Sheets("FR-PYLON").Select
  Cells(x + 10, 11).Select
  ActiveSheet.Paste
 
    xx = 1
    Do While Sheets("MTL").Range(R.Address).Value = Sheets("MTL").Range(R.Address).Offset(xx, 0).Value
    Sheets("MTL").Select
    Range(R.Address).Offset(xx, 1).Select
    Selection.Copy
    
    Sheets("FR-PYLON").Select
    Cells(x + 10, 11 + xx).Select
    ActiveSheet.Paste
    xx = xx + 1
    Loop
    
x = x + 1
Loop

  Range(R.Address).Offset(0, 1).Select
  Selection.Copy
  
  Sheets("FR-PYLON").Select
  Cells(x + 10, 11).Select
  ActiveSheet.Paste
 
Application.ScreenUpdating = True

Sheets("FR-PYLON").Range("a13").Select


End Sub
 

Pièces jointes

  • Test fiche v2.xlsm
    35.2 KB · Affichages: 57

Discussions similaires

Statistiques des forums

Discussions
311 733
Messages
2 082 019
Membres
101 872
dernier inscrit
Colin T