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 secondque je peux appliquer à "Overview"?
Code : Sélectionner tout - Visualiser dans une fenêtre à part As Long
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!!






Répondre avec citation
Partager