Re : Macro pour reporter des data - correction code
Re bonjour
bon ben pas de reponse alors je retente un coup. desole!
Le code est dessous et mon pb est que
1/ les donnees ne se reportent pas sur la feuille cree mais sur une autre feuille (voir file attache pour les + patients)
2/ Enfin j`aurai aime arriver a reporter en meme temps le nom de la feuille source Q1/Q2/Q3/Q4 selon les cas:
Pour le point 1, je suis sur que bcp de gens du site vont trouver ma boulette. Donc desole de relancer et merci pour votre aide : 🙄
Option Explicit
Private Sub CommandButton1_Click()
Dim feuilles As Variant
Dim pays() As String
Dim fichier As Workbook
Dim feuille As Worksheet
Dim j As Integer, i As Integer, k As Integer
Dim derligne As Integer
Dim c As Range
Dim sh, tablo()
If ComboBox1.ListIndex = -1 Then
MsgBox "Please, select a country.", , "Warning"
Exit Sub
End If
'recherche des pays concernées
If ComboBox1.ListIndex = 0 Then
ReDim pays(ComboBox1.ListCount - 2)
For i = 1 To ComboBox1.ListCount - 1
pays(i - 1) = ComboBox1.List(i)
Next i
Else
ReDim pays(0)
pays(0) = ComboBox1
End If
'recherche les feuilles concernées
For i = 1 To 5
With Controls("optionbutton" & i)
If .Value = True Then
Select Case .Caption
Case "All": feuilles = Array("Q1", "Q2", "Q3", "Q4")
Case Else: feuilles = Array(.Caption)
End Select
End If
End With
Next i
'si aucune option est choisie on sort
If Not IsArray(feuilles) Then
MsgBox "Please select a period.", , "Warning"
Exit Sub
End If
If ExisteFeuille(ComboBox1) = True Then
Set feuille = Sheets(ComboBox1.Value)
Else
Set feuille = Sheets.Add
feuille.Move after:=Sheets(Sheets.Count)
End If
With feuille
.Name = ComboBox1.Value
.Cells.Clear
End With
'recherche des données par pays et par options
For i = 0 To UBound(feuilles)
With Worksheets(CStr(feuilles(i)))
For k = 0 To UBound(pays)
For Each c In .Range("b2:b" & .Range("b65536").End(xlUp).Row)
If c = pays(k) Then
derligne = Worksheets(1).Range("a65536").End(xlUp).Row + 1
For j = 1 To 50
Worksheets(1).Cells(derligne, j) = .Cells(c.Row, j)
Next j
Worksheets(1).Cells(derligne, 31) = feuilles(i)
End If
Next c
Next k
End With
Next i
End Sub
c`est long mais qu`est ce que c`est bon quand ca marche!
merci et bonne nuit
Happymarmotte