Copier les onglets d'un classeur

[lostheroe]

Bonjour,
J'ai une macro qui me permet de copier tout les onglets dans l'onglet base article.
La macro copie bien les onglets. Mais au lieu de mettre les valeurs à la suite les une des autres.
Elles efface les valeurs. Ce qui fait que seul le dernière onglet est copier et coller au finale.
Il devrait y avoir dans l'exemple 6285+533 lignes sur l'onglet bas article. Alors qu'il y en a 6285 ce qui correspond juste au premiere onglet.
La macro ne marche pas bien des qu'on dépasse les 6000 lignes.
En-dessous ça marche bien.

Je sais pas comment modifier la macro.

 

[Robert]

Re : Copier les onglets d'un classeur

Bonjour Lostheroe, bonjour le forum,

Essaie comme ça :

Sub Import()
Dim i As Integer
Dim rg As Range, rgP As Range
Dim wsBase As Worksheet
 
Set wsBase = ThisWorkbook.Sheets("Base article")
'effacer les données existantes à partir de la ligne 2
wsBase.Range("A2:D" & wsBase.Cells(Application.Rows.Count, 4).End(xlUp).Row).Clear
' on suppose que la base est le 1er onglet, donc on commence au 2e et on se rend au dernier
For i = 1 To Sheets.Count
    If Sheets(i).Name <> "Base article" Then
        Set rg = Sheets(i).Range("A2:D" & Sheets(i).Cells(Application.Rows.Count, 4).End(xlUp).Row)
        Set rgP = wsBase.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0)  'une seule fois sinon ça plante
        rg.Copy rgP
    End If
Next i
End Sub

 

[lostheroe]

Re : Copier les onglets d'un classeur

Merci ça marche impec.

 

[pierrejean]

Re : Copier les onglets d'un classeur

Bonjour lostheroe

Salut Robert 🙂 🙂

une autre version:

Sub Import_b()
    Dim i As Integer
    Dim rg As Variant, rgP As Range
    Dim wsBase As Worksheet
    Set wsBase = ThisWorkbook.Sheets("Base article")
    'effacer les données existantes à partir de la ligne 2
   wsBase.Range("A2:D" & wsBase.Range("D65536").End(xlUp).Row).ClearContents
    ' on suppose que la base est le 1er onglet, donc on commence au 2e et on se rend au dernier
  For i = 2 To Sheets.Count
       rg = Sheets(i).Range("A2:D" & Sheets(i).Range("D65536").End(xlUp).Row)
       Set rgP = wsBase.Range("A65536").End(xlUp).Offset(1, 0)
       rgP.Resize(UBound(rg, 1), UBound(rg, 2)) = rg
    Next i
End Sub

 

[lostheroe]

Re : Copier les onglets d'un classeur

Bonjour,

J'aurais voulu savoir ce qu'il faut rajouter dans la macro ci-dessous pour que les prix lors de l'importation soit arrondi a l'unité supérieure (ex au lieu de 65.1 avoir 66).

Sub Import()
Dim i As Integer
Dim rg As Range, rgP As Range
Dim wsBase As Worksheet

Set wsBase = ThisWorkbook.Sheets("Base article")
'effacer les données existantes à partir de la ligne 2
wsBase.Range("A2😀" & wsBase.Cells(Application.Rows.Count, 4).End(xlUp).Row).Clear
' on suppose que la base est le 1er onglet, donc on commence au 2e et on se rend au dernier
For i = 1 To Sheets.Count
If Sheets(i).Name <> "Base article" Then
Set rg = Sheets(i).Range("A2😀" & Sheets(i).Cells(Application.Rows.Count, 4).End(xlUp).Row)
Set rgP = wsBase.Cells(Application.Rows.Count, 1).End(xlUp).Offset(1, 0) 'une seule fois sinon ça plante
rg.Copy rgP
End If
Next i
End Sub


Merci