Selection de plusieurs onglets

[layo0789]

Bonjour à tous,

Je dois réaliser une macro qui me permet de copier certains onglets fichier(1,2,3...) et de les rassembler dans un onglet défini (Feuil1).
J'ai parcouru le forum, et j'y ai trouvé mon bonheur.
Cependant, j'ai besoin de ne copier que certains onglets.
Pouvez-vous m'aider.

Voici mon code

Option Explicit

Sub ConcatenationFeuilles()
Dim i As Long, T() As Variant, fichier(1 To 100) As Range
fichier(1) = "SCRL_RE_PAY"
fichier(2) = "SCRL_FAE"
fichier(3) = "SA_PAY"


Application.ScreenUpdating = False
Sheets("Feuil1").Cells.Clear


' Copie En-Tête
' Au cas ou la feuille de synthèse se trouverait en 1ere position
For i = 1 To Worksheets.Count
If Worksheets(i).Name <> Sheets("Feuil1").Name Then
With Worksheets(i)
T = .Range("A11").Value
Sheets("Feuil1").Range("A1").Resize(UBound(T, 1), UBound(T, 2)) = T
End With
Exit For
End If
Next i

' Copie des données
For i = 1 To Worksheets.Count
If Worksheets(i).Name <> Sheets("Feuil1").Name Then
With Worksheets(i)
T = .Range("A2" & .Range("A" & Rows.Count).End(xlUp).Row).Value
Sheets("Feuil1").Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(T, 1), UBound(T, 2)) = T
End With
End If
Next i
Erase T
Application.ScreenUpdating = True
End Sub

 

[gosselien]

Re : Selection de plusieurs onglets

Bonjour,

petite modif à tester

Option Explicit

Sub ConcatenationFeuilles()
Dim i As Long, T() As Variant, fichier(1 To 100) As Range
Dim Ws1, Ws2, Ws3
Set Ws1 = Sheets("F1")
Set Ws2 = Sheets("F2")
Set Ws3 = Sheets("F3")
Application.ScreenUpdating = False
'Ws1.Cells.Clear
' Copie En-Tête
' Au cas ou la feuille de synthèse se trouverait en 1ere position
For i = 1 To Worksheets.Count
If Worksheets(i).Name <> Sheets("F1").Name Then
With Worksheets(i)
T = .Range("A11").Value
Ws1.Range("A2").Resize(UBound(T, 1), UBound(T, 2)) = T
End With
Exit For
End If
Next i
' Copie des données
For i = 1 To Worksheets.Count
If Worksheets(i).Name <> Sheets("F1").Name Then
With Worksheets(i)
T = .Range("A2" & .Range("A" & Rows.Count).End(xlUp).Row).Value
Ws1.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(T, 1), UBound(T, 2)) = T
End With
End If
Next i
Erase T
Application.ScreenUpdating = True
End Sub

 

[layo0789]

Re : Selection de plusieurs onglets

Re-bonjour,

Merci pour votre réponse.
Cependant, je pense qu'il manque dans la boucle une condition qui dit
si le nom de l'onglet est inclut dans la plage (ws1, ws2,...)
Alors on copie

 

[gosselien]

Re : Selection de plusieurs onglets

ceci peut être alors

Option Explicit

Sub ConcatenationFeuilles()
Dim i As Long, T() As Variant
Dim Liste
Dim Ws1
Set Ws1 = Sheets("F1")
Liste = Array("F1", "F2", "F3")
Application.ScreenUpdating = False
' Au cas ou la feuille de synthèse se trouverait en 1ere position
For i = 1 To Worksheets.Count
If Worksheets(i).Name <> Sheets("F1").Name Then
With Worksheets(i)
T = .Range("A11").Value
Ws1.Range("A2").Resize(UBound(T, 1), UBound(T, 2)) = T
End With
Exit For
End If
Next i
' Copie des données
For i = 1 To Worksheets.Count
' je ne copie que les feuilles qui sont dans "LISTE" déclarée en haut
On Error Resume Next
If Not Worksheets(i).Name = Liste(i - 1) Then Exit Sub
'
If Worksheets(i).Name <> Sheets("F1").Name Then
With Worksheets(i)
T = .Range("A2" & .Range("A" & Rows.Count).End(xlUp).Row).Value
Ws1.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(UBound(T, 1), UBound(T, 2)) = T
End With
End If
Next i
Erase T
Application.ScreenUpdating = True
End Sub