Discussion :

[alhousseini]

Bonjour ,

Après avoir galeré toute la journée d' hier , a copier et à coller à la main un

fichier 2500 lignes , je comprend l'importance des macros...

J'ai deux onglets à lier grace au numero et nom de l'entreprise se trouvant

dans la colonne 1 et 2 ...le tout à mettre dans un troisiemme onglet..

J'essaye le code suivant qui copie juste le premier ongelt sans rajouter les lignes de l'ongelt 2.

Si quelqu'un à une idée?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub report()
Dim coltotal As Integer
ColFin = Sheets("Feuil1").Range("IV1").End(xlToLeft).Column
LigFin = Sheets("Feuil1").Range("A65536").End(xlUp).Row
Sheets("Feuil1").Range(Cells(1, 1).Address, Cells(LigFin, ColFin - 1).Address).Copy Destination:=Sheets("Feuil3").Range("A1")
colfin1 = Sheets("Feuil2").Range("IV1").End(xlToLeft).Column
Sheets("Feuil2").Range(Cells(1, 3).Address, Cells(1, colfin1).Address).Copy Destination:=Sheets("Feuil3").Cells(1, ColFin)
 
For n = 2 To Sheets("Feuil2").Range("A65536").End(xlUp).Row
  For m = 2 To Sheets("Feuil3").Range("A65536").End(xlUp).Row
   If Sheets("Feuil2").Range("A" & n) & Sheets("Feuil2").Range("B" & n) = Sheets("Feuil3").Range("A" & m) & Sheets("Feuil3").Range("B" & m) Then
      Sheets("Feuil2").Range(Cells(n, 3).Address, Cells(n, colfin1).Address).Copy Destination:=Sheets("Feuil3").Cells(m, ColFin)
      trouve = True
   End If
  Next m
  If trouve = False Then
    finf3 = Sheets("Feuil1").Range("A65536").End(xlUp).Row + 1
    Sheets("Feuil2").Range(Cells(n, 1).Address, Cells(n, 2).Address).Copy Destination:=Sheets("Feuil3").Cells(finf3, 1)
    Sheets("Feuil2").Range(Cells(n, 3).Address, Cells(n, colfin1).Address).Copy Destination:=Sheets("Feuil3").Cells(finf3, ColFin)
  End If
  trouve = False
Next n
coltotal = Sheets("Feuil3").Range("IV1").End(xlToLeft).Column
For n = 2 To Sheets("Feuil3").Cells(65536, coltotal).End(xlUp).Row
 Cells(n, coltotal).Formula = "=SUM(C" & n & ":" & lettre(coltotal - 1) & n & ")"
Next n
End Sub
Function lettre(nb As Integer)
lettre = Left(Cells(1, nb).Address(0, 0), Len(Cells(1, nb).Address(0, 0)) - 1)
End Function

[mercatog]

Une proposition

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub Report()
Dim NbL As Long
Dim NbC As Integer
 
Application.ScreenUpdating = False
With Sheets("Feuil3")
    .UsedRange.Clear
    Sheets("Feuil1").UsedRange.Copy .Range("A1")
    NbL = .UsedRange.Rows.Count + 1
    Sheets("Feuil2").UsedRange.Offset(1, 0).Copy .Range("A" & NbL)
    NbL = .UsedRange.Rows.Count + 1
    NbC = .UsedRange.Columns.Count
    .Range(.Cells(NbL, 1), .Cells(NbL, NbC)).FormulaR1C1 = "=SUM(R[" & 2 - NbL & "]C:R[-1]C)"
End With
End Sub