Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

Selection de plusieurs onglets

layo0789

XLDnaute Nouveau
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

XLDnaute Barbatruc
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

XLDnaute Nouveau
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

XLDnaute Barbatruc
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
 
Dernière édition:

Discussions similaires

Réponses
11
Affichages
347
Réponses
2
Affichages
303
Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…