Macro

Bonjour !

Je souhaiterais avoir une ecriture macro qui fasse la selection de differentes feuilles cibles et ce dans differents fichiers ( les feuilles ayant des noms differents).

dans mon example ci-dessous ma macro arrive bien a chercher toutes les feuilles du meme nom dans differents fichiers du dossier.

Target_Worksheet = "Actual GB AL"

ThisWorkbook.Sheets(Target_Worksheet).Cells.Clear

Path = ThisWorkbook.Path

Start = True

(ceci n'est qu'une partie de ma macro bien sur) .

Probleme: j'ai plusieurs feuille example :"Actual GB AL" "Actual GB AK" "Actual GB AJ"

comment ecrire la macro pour que ça cherche ces differents noms?

Merci d'avance ça me sera d'une grande utilité.

For each sh in thisworkbook.worksheets
If left(sh.name,9) = "Actual GB" then
ThisWorkbook.Sheets(sh.name).Cells.Clear
Path = ThisWorkbook.Path
Start = True
....
next sh

merci pour ce code mais je comprend pas ton code, quel moment je dois rajouter les autres nom de feuille,

juste la comme ca mon écriture fonctionne bien mais a la seule condition que les feuilles aient le meme nom

or je veux rajouter autres noms de feuilles

merci

bonjour, je sais que je l'avais deja posté cette macro mais j'ai pas eu de reponse saisfaisante.

voila comment j'ai adapté ma maro pour que ça me regroupe les differentes feuilles mais ça pas l'air de marcher.

pouriez vous me dire pourquoi?

si vous avez besoin de savoir un detail pour pouvoir m'aider n'hesitez surtout pas.

Merci d'avance

Sub GB _Global()

'Variables Declaration

Dim Path As String, File As String

Dim Worksheet As Worksheet

Dim Target_Worksheet As String

Dim OK_Worksheet As Boolean, Start As Boolean

Dim Name As Name

Dim FirstLine As Long, LastLine As Long, LastLineTarget As Long

Dim FirstColumn As Long, LastColumn As Long

Target_Worksheet = "Actual GB AL" then "Actual GB PAG" then "Actual GB QHJ"

ThisWorkbook.Sheets(Target_Worksheet).Cells.Clear

Path = ThisWorkbook.Path

Start = True

'If unsaved file, then no path => always save the file before executing the macro

If Path <> "" Then

'Filters only on Excel files

File = Dir(Path & "\*.*xls*")

'Only "esthetic" : improves speed and processing appearance (deactivating sreen update)

Application.ScreenUpdating = False

Do While File <> ""

If File <> ThisWorkbook.Name Then

Workbooks.Open Filename:=Path & "\" & File, ReadOnly:=True, UpdateLinks:=False

Application.DisplayAlerts = False

'Test if worksheet exists

OK_Worksheet = False

For Each Worksheet In Workbooks(File).Sheets

If Worksheet.Name = Target_Worksheet Then OK_Worksheet = True: Exit For

Next

'If worksheet OK => copies worksheet content to "Global" file

If OK_Worksheet Then

Worksheet.Unprotect Password:="FCII"

Worksheet.Columns.Ungroup

Worksheet.AutoFilterMode = False

'Sets the range to copy in "Global"

FirstLine = Lookforfirstline(Workbooks(File), Target_Worksheet) + 1

If Not Start Then FirstLine = FirstLine + 1

Start = False

LastLine = LookforLastline(Workbooks(File), Target_Worksheet)

FirstColumn = LookforFirstColumn(Workbooks(File), Target_Worksheet)

LastColumn = LookforLastColumn(Workbooks(File), Target_Worksheet)

LastLineTarget = LookforLastline(ThisWorkbook, "Actual GB AL" then "Actual GB PAG" then "Actual GB QHJ" + 1

'No copy of the header if not the first file copied

With Workbooks(File).Sheets(Target_Worksheet)

.Range(.Cells(FirstLine, FirstColumn).Address & ":" & .Cells(LastLine, LastColumn).Address).Copy Destination:=ThisWorkbook.Sheets("Actual GB AL" then "Actual GB PAG" then "Actual GB QHJ").Range("A" & LastLineTarget)

End With

'Deletes named cells

For Each Name In ThisWorkbook.Names

Name.Delete

Next

Start = False

End If

Worksheet.Protect Password:="FCII"

Workbooks(File).Close False

End If

File = Dir

Loop

'Breaks Links

Dim Link As Variant

For Each Link In ActiveWorkbook.LinkSources

ActiveWorkbook.BreakLink Name:=Link, Type:=1

Next

'Deletes Data/Validation

Sheets ("Actual GB AL" then "Actual GB PAG" then "Actual GB QHJ").Select

Cells.Validation.Delete

'Deletes Conditional Formatting

Sheets( "Actual GB AL" then "Actual GB PAG" then "Actual GB QHJ").Select

Cells.FormatConditions.Delete

'Sorts data by Name & First Name

Cells.Select

ActiveWorkbook.Worksheets ("Actual GB AL" then "Actual GB PAG" then "Actual GB QHJ").Sort.SortFields.Clear

ActiveWorkbook.Worksheets ("Actual GB AL" then "Actual GB PAG" then "Actual GB QHJ").Sort.SortFields.Add Key:=Range( "l2:l1048576"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

xlSortNormal

ActiveWorkbook.Worksheets( "Actual GB AL" then "Actual GB PAG" then "Actual GB QHJ").Sort.SortFields.Add Key:=Range( _

"m2:m1048576"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _

xlSortNormal

With ActiveWorkbook.Worksheets( "Actual GB AL" then "Actual GB PAG" then "Actual GB QHJ").Sort

.SetRange Rows("1:01048576")

.Header = xlYes

.MatchCase = False

.Orientation = xlTopToBottom

.SortMethod = xlPinYin

.Apply

End With

' Filters

Range("A1").Select

Range(Selection, Selection.End(xlToRight)).Select

Range(Selection, Selection.End(xlDown)).Select

Selection.AutoFilter

Sheets("Updates").Select

' Re-activates Display Alerts

Application.DisplayAlerts = True

' Re-activates screen update

Application.ScreenUpdating = True

End If

End Sub