Bonjour à toutes et à tous,

J'ai un pb avec un "copy/paste". En effet, je souhaite réunir sur une feuille "Overview", les données de plusieurs feuilles excel.
Comment puis je faire, pour que les données présentes sur "6006528" (à partir de la ligne 78 comme indiqué) se copient dans "Overview" dans une autre ligne que je peux définir manuellement?
Je m'explique, j'utilise le code ci-dessous pour 30 macros différentes et un nombre de lignes de données variant de 200 à 300 lignes.
Mais comme j'indique ligne 78, les données de la dernière page que je charge, écrasent celles de la précédente dans "Overview"

Est ce possible d'insérer un second que je peux appliquer à "Overview"?

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
Sub D6006528()
 
Sheets("6006528").Cells.Clear
 
    With Sheets("6006528").QueryTables.Add(Connection:= _
        "URL;XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX" _
        , Destination:=Sheets("6006528").Range("$A$1"))
        .Name = "carType"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = False
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = True
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .WebSelectionType = xlEntirePage
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
Dim Lig As Long
 
For Lig = 78 To Worksheets("6006528").Range("A81").End(xlDown).Row Step 2
    'Dim + Marque + Profil
    Worksheets("Overview").Cells(Lig + 1, 3) = Worksheets("6006528").Cells(Lig + 2, 1)
    'Preis
    Worksheets("Overview").Cells(Lig + 1, 7) = Worksheets("6006528").Cells(Lig + 2, 5)
    'Kennung
    Worksheets("Overview").Cells(Lig + 1, 6) = Worksheets("6006528").Cells(Lig + 2, 2)
    'LI/SI
    Worksheets("Overview").Cells(Lig + 1, 5) = Worksheets("6006528").Cells(Lig + 3, 1)
Next
 
 
Worksheets("Overview").Range("C4:C1000").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub

Merci énormément!!