Bonjour,
J'ai créé un code avec mon peu de VBA, me permettant de consolider dans un tableau unique (onglet "CONSO"), les commandes de trente de magasins, à partir autres onglets du classeur en pièce jointe, chaque onglet représentant un fournisseur. J'ai 2 problèmes :
- Le nombres d'onglet peut varier en fonction des fournisseurs a qui on a passé commande
- Les 14 premières colonnes sont identiques sur tous les onglets mais les suivantes dépendent du nombre magasins qui ont passé commande au fournisseur concerné (1 colonne par magasin).
Le code ci-dessous récupère les informations des 14 premières colonnes de chaque onglet, et vient les coller l'une à la suite de l'autre dans l'onglet conso.
Je bloque pour compléter les 30 colonnes des magasins
L'objectif est de rechercher dans chaque onglet fournisseur, le magasin concerné, et reporter le nombre d'article commandés, dans l'onglet conso.
Sub Recup()
Worksheets("CONSO").Range("A2:N1000").ClearContents
Dim Fe As Worksheet
Dim Plage As Range
'parcour la collection en évitant kla feuille
'de consolidation
For Each Fe In ThisWorkbook.Worksheets
If Fe.Name <> "CONSO" Then
With Fe
'Renomme chaque feuille à partir du libellé fournisseur
Dim xWs As Worksheet
Dim xRngAddress As String
Dim xName As String
Dim xSSh As Worksheet
Dim xInt As Integer
xRngAddress = Application.ActiveCell.Address
On Error Resume Next
Application.ScreenUpdating = False
xName = xWs.Range(xRngAddress).Value
If xName <> "" Then
xInt = 0
Set xSSh = Nothing
Set xSSh = Worksheets(xName)
While Not (xSSh Is Nothing)
Set xSSh = Nothing
Set xSSh = Worksheets(xName & "(" & xInt & ")")
xInt = xInt + 1
Wend
If xInt = 0 Then
xWs.Name = xName
Else
If xWs.Name <> xName Then
xWs.Name = xName & "(" & xInt & ")"
End If
End If
End If
Application.ScreenUpdating = True
'définie la plage sans la ligne de titres
Set Plage = .Range(.Cells(2, 1), _
.Cells( _
.Cells.Find("*", .[A1], -4123, , _
1, 2).Row, _
.Cells.Find("*", .[O1], -4123, , _
2, 2).Column))
End With
'colle les valeurs dans la feuille de consolidation
'après la dernière ligne non vide
Plage.Copy _
Worksheets("CONSO").Range("A65536:N65536").End(xlUp).Offset(1, 0)
End If
Next Fe
' Supprime les lignes vides
Rows("1:1").Select
Selection.AutoFilter
Columns("L:L").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
Rows("1:1").Select
Selection.AutoFilter
End Sub
Merci d'avance si vous pouvez m'aider!
J'ai créé un code avec mon peu de VBA, me permettant de consolider dans un tableau unique (onglet "CONSO"), les commandes de trente de magasins, à partir autres onglets du classeur en pièce jointe, chaque onglet représentant un fournisseur. J'ai 2 problèmes :
- Le nombres d'onglet peut varier en fonction des fournisseurs a qui on a passé commande
- Les 14 premières colonnes sont identiques sur tous les onglets mais les suivantes dépendent du nombre magasins qui ont passé commande au fournisseur concerné (1 colonne par magasin).
Le code ci-dessous récupère les informations des 14 premières colonnes de chaque onglet, et vient les coller l'une à la suite de l'autre dans l'onglet conso.
Je bloque pour compléter les 30 colonnes des magasins
L'objectif est de rechercher dans chaque onglet fournisseur, le magasin concerné, et reporter le nombre d'article commandés, dans l'onglet conso.
Sub Recup()
Worksheets("CONSO").Range("A2:N1000").ClearContents
Dim Fe As Worksheet
Dim Plage As Range
'parcour la collection en évitant kla feuille
'de consolidation
For Each Fe In ThisWorkbook.Worksheets
If Fe.Name <> "CONSO" Then
With Fe
'Renomme chaque feuille à partir du libellé fournisseur
Dim xWs As Worksheet
Dim xRngAddress As String
Dim xName As String
Dim xSSh As Worksheet
Dim xInt As Integer
xRngAddress = Application.ActiveCell.Address
On Error Resume Next
Application.ScreenUpdating = False
xName = xWs.Range(xRngAddress).Value
If xName <> "" Then
xInt = 0
Set xSSh = Nothing
Set xSSh = Worksheets(xName)
While Not (xSSh Is Nothing)
Set xSSh = Nothing
Set xSSh = Worksheets(xName & "(" & xInt & ")")
xInt = xInt + 1
Wend
If xInt = 0 Then
xWs.Name = xName
Else
If xWs.Name <> xName Then
xWs.Name = xName & "(" & xInt & ")"
End If
End If
End If
Application.ScreenUpdating = True
'définie la plage sans la ligne de titres
Set Plage = .Range(.Cells(2, 1), _
.Cells( _
.Cells.Find("*", .[A1], -4123, , _
1, 2).Row, _
.Cells.Find("*", .[O1], -4123, , _
2, 2).Column))
End With
'colle les valeurs dans la feuille de consolidation
'après la dernière ligne non vide
Plage.Copy _
Worksheets("CONSO").Range("A65536:N65536").End(xlUp).Offset(1, 0)
End If
Next Fe
' Supprime les lignes vides
Rows("1:1").Select
Selection.AutoFilter
Columns("L:L").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
Rows("1:1").Select
Selection.AutoFilter
End Sub
Merci d'avance si vous pouvez m'aider!