Optimisation double loop

Bonjour à tous,

J'ai besoin d'une petite aide concernant de l'optimisation de code et gestion des ressources. Merci d'avance pour vos réponses

J'ai fait cette petite fonction dont voici le contexte :

1 fichier excel, 2 sheets avec des données.

Le but recherché : concatener dans une nouvelle sheet une colonne du sheet 1 avec une autre du sheet 2 - avec répétition de cette seconde et de manière automatique

( avec pour seule obligation le respect du nom des sheets et des colonnes. - je m'occupe du debug sur les noms plus tard).

mon raisonnement, je stocke mes 2 tableaux de données à concatener et puis je les parcours.

Exemple :

Sheet1

FIRST

A

B

C

--------------------------

Sheet 2

SECOND

1

2

3

--------------------------

résultat souhaité Sheet3:

A1

A2

A3

B1

B2

B3

C1

C2

C3

----------------------------------------------------

CODE :

Sheets("sheet1").Select
Rows("1:1").Select
Selection.Find(What:="FIRST", After:=ActiveCell, LookIn:= _
xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Select
Dim selection_S1 As Range
Set selection_S1 = Range(Selection, Selection.End(xlDown))

Sheets("sheet2").Select
Rows("1:1").Select
Selection.Find(What:="SECOND", After:=ActiveCell, LookIn:= _
xlFormulas2, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Offset(1, 0).Select
Dim selection_S2 As Range
Set selection_S2= Range(Selection, Selection.End(xlDown))

Dim j As Integer

j = 0
Sheets.Add
ActiveSheet.Name = "Sheet3"
Sheets("Sheet3").Select

For Each cellule_S2 In selection_S2

     For Each cellule_S1 In selection_S1
          Range("B2").Offset(j, 0).Value = cellule_S1 .Value & " " & cellule_S2 .Value
          j = j + 1
     Next

Next

Bonjour et bienvenue sur le forum

Un essai à tester. Te convient-il ?

Option Explicit

Dim f As Worksheet, f1 As Worksheet, f2 As Worksheet
Dim tablo1, tablo2, tablo3()
Dim i1&, i2&, i3&, flag&

Sub Optimiser()

    flag = 0
    For Each f In Worksheets
        If f.Range("A1") = "FIRST" Then
            Set f1 = f
            flag = 1
        ElseIf f.Range("A1") = "SECOND" Then
            Set f2 = f
            flag = flag + 1
        End If
    Next f

    If flag < 2 Then
        Exit Sub
    Else
        Sheets.Add
    End If

    tablo1 = f1.Range("A1").CurrentRegion
    tablo2 = f2.Range("A2").CurrentRegion
    ReDim tablo3(1 To (UBound(tablo1, 1) - 1) * (UBound(tablo2, 1) - 1), 1 To 1)

    i3 = 0
    For i1 = 2 To UBound(tablo1, 1)
        For i2 = 2 To UBound(tablo2, 1)
            tablo3(i3 + 1, 1) = tablo1(i1, 1) & tablo2(i2, 1)
            i3 = i3 + 1
        Next i2
    Next i1

    Range("A2").Resize(UBound(tablo3, 1), 1) = tablo3
    Range("A1") = "Résultat"
End Sub

Bye !

Bonjour et bienvenue,
2 propositions Power Query.
1 - Mise à jour manuelle (xlsx)
2 - Mise à jour auto via VBA (xlsm).
Cdlt.

Bonjour,

2 réponses très satisfaisantes répondant totalement à mon attente!

les approches sont différentes mais ca me permet un gros gap de performance et le code est très lisible !

concernant le power query, c'est nouveau pour moi mais ces 2 fichiers m'ouvrent une nouvelle perspective et c'est également très clair !

Merci beaucoup.