Bonjour à tous,

Merci du temps que vous pourrez me consacrer pour m'accompagner sur cette demande
Ce sujet ressort très souvent et je me vois désolé mais je tourne en rond sur cette macro

je dois traiter un fichier de tarifs constructeurs qui comporte a la base 2 onglets (tarif1 & tarif2) chaque onglet compte grosso modo 1 050 000 & 630 000 lignes et pèse dans sa forme initiale 120Mo
je traite par le biais de différentes macro une épuration des différentes colonnes inutiles, doublons pour ramener celui ci a une taille de 50 Mo et toujours 2 onglets 847 000 & 510 000 lignes.

Bien entendu que les 2 onglets sont de conception identiques 4 colonnes avec nommage (Familly / Product / Product Description / Price in USD)

Je dois pour pousser encore plus loin ce régime maintenant fusionner ses 2 onglets en 1 seul.
l'objectif extraire les familles de produit qui me sont réellement utiles dans mon CRM.

j'ai parcouru plusieurs Forums et je suis tombé sur cette macro que je n'arrive pas à adapter a mon besoin

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
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
Sub TableauFinal()
 
Dim sh As Worksheet, F As Worksheet
 
Set sh = Worksheets.Add
On Error Resume Next
Application.DisplayAlerts = False
Sheets("DmResultat").Delete
Application.DisplayAlerts = True
sh.Name = "DmResultat"
 
For Each F In Worksheets
If F.Name <> sh.Name Then
If WorksheetFunction.CountA(F.UsedRange) <> 0 Then
With F
.Range(.Cells(1, 1), .Cells(DerLig(F), DerCol(F))).Copy _
sh.Cells(DerLig(sh) + 1, 1)
End With
End If
End If
Next
Set sh = Nothing: Set F = Nothing
 
 
End Sub
 
'--------------------------------------
Function DerLig(sh As Worksheet)
On Error Resume Next
DerLig = sh.Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
On Error GoTo 0
End Function
'--------------------------------------
Function DerCol(sh As Worksheet)
On Error Resume Next
DerCol = sh.Cells.Find(What:="*", _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
On Error GoTo 0
End Function
'--------------------------------------
Celle ci me copie correctement les 847 000 lignes de tarif1 mais ne prend pas en compte les lignes de tarif2.

Je vous remercie par avance de l'aide que vous pourriez m'apporter
Chris