VBA - Copier à partir de la dernière ligne

**TintinU2** · 12/10/2015, 17h05

Bonjour à tous,

Je débute dans la programmation VBA et je m'expose à quelques problèmes

Je vous expose mon problème :
Je dois récupérer sur un fichier externe à mon classeur, les données le contenant. J'extrais ces données dans ma feuille "Extraction". Ma feuille "Extraction" ne me sert que d'emplacement de stockage provisoire.
Dans une autre feuille "Base de donnée" je dois récupérer les données stockées dans "Extraction".
Pour cela je traite les doublons en supprimant les numéros double (qui sont unique à chaque ligne)
Je supprimes la première ligne qui me sert à rien
Et j'aimerai copier les lignes qu'il me reste(de ma feuille "Extraction"), à la première ligne vide (dans "Base de donnée")

Voici mon code :

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
46
47
48
49
Sub Copie_en_interne()
 
    'Désactive la mise à jour de l'affichage
    Application.ScreenUpdating = False
 
  '***************************'
  '*Debut de la vérification du numéro*'
  '***************************'
  Dim i As Integer
  Dim BDD As Range 'Base de donnée = BDD
 
  'Definition plage de cellules en memoire pour vitesse execution
  Set BDD = Worksheets("Base de donnée").Range("B1:B200000")
 
  With ThisWorkbook.Sheets("Extraction")
    For i = 200 To 2 Step -1
      'Vérifie les numéros dans l'extration par rapport à la base de donnée
      If Application.CountIf(BDD, .Range("B" & i).Value) <> 0 Then
        'Supprime les numéros doublons
        .Rows(i).Delete
      End If
    Next i
  End With
 
  '*************************'
  '*Fin de la vérification du numéro*'
  '*************************'
 
 
 
  '******************************'
  '*Début des copies des données*'
  '******************************'
    Sheets("Extraction").Select
    'on supprime la première ligne avec les titres
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    'on copie toutes les colonnes
    Columns("A:P").Select
    Selection.Copy
    'On colle les données dans la base de donnée
    Sheets("Base de donnée").Select
    Columns("A:P").Select
    ActiveSheet.Paste
 
  '****************************'
  '*Fin des copies des données*'
  '****************************'
End Sub

Pour le moment je copie depuis la première ligne.

J'ai essayé de copier à partir de la cellule que j'ai pré-sélectionné, mais cela ne fonctionne pas

Code :

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

1
2
3
4
5
6
 'détermine la dernière ligne active
    der_ligne = Range("A1").End(xlDown).Row + 1
    MsgBox der_ligne
 
    Cells(der_ligne, 1).Select
    ActiveCell.Paste

Je suis sur que mon erreur est trop bête mais j'en appelle à vos expériences pour m'aider.

Je vous en remercie d'avance

TintinU2

**TintinU2** · 14/10/2015, 10h18

J'ai finalement résolu mon problème.
Je copiais toute les colonnes de A jusqu’à P et de la ligne 1 jusqu'à 1048576.
Ce qui faisait un fichier énorme et je ne pouvais pas copier 1048576 lignes dans une nouvelle feuille plus les lignes existante

Erreur de débutant on va dire

Je laisse mon code solutionné pour des novices comme moi qui passeraient par ici

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
46
47
48
49
50
51
52
53
54
55
56
Sub Copie_en_interne()
 
    'Désactive la mise à jour de l'affichage
    Application.ScreenUpdating = False
 
 
  '**********************************************'
  '*Debut de la vérification du numéro*'
  '**********************************************'
  Dim i As Integer
  Dim Ext As Range 'Extraction = Ext
 
  'Definition plage de cellules en memoire pour vitesse execution
  Set Ext = Worksheets("Extraction").Range("B1:B200")
 
  With ThisWorkbook.Sheets("Base de donnée")
    For i = 20000 To 2 Step -1
      'Vérifie les numéros de Tickets dans l'extration par rapport à la base de donnée
      If Application.CountIf(Ext, .Range("B" & i).Value) <> 0 Then
        'Supprime les tickets doublons
        .Rows(i).Delete
      End If
    Next i
  End With
 
  '********************************************'
  '*Fin de la vérification du numéro*'
  '********************************************'
 
  '******************************'
  '*Début des copies des données*'
  '******************************'
    Sheets("Extraction").Select
    'on supprime la première ligne
    Rows("1:1").Select
    Selection.Delete Shift:=xlUp
    'on selectionne la dernière ligne dans la feuille Extraction
    der_ligne_ext = Range("A1").End(xlDown).Row + 2
    MsgBox der_ligne_ext
    'on copie toutes les colonnes
    Range("A1:P" & der_ligne_ext).Select
    Selection.Copy
 
    'On colle les données dans la base de donnée
    Sheets("Base de donnée").Select
    'détermine la dernière ligne active
    der_ligne = Range("A1").End(xlDown).Row + 1
    MsgBox der_ligne
    'détermine la dernière ligne active
    Range("A" & der_ligne & ":P" & der_ligne).Select
    ActiveSheet.Paste
 
  '****************************'
  '*Fin des copies des données*'
  '****************************'
End Sub

Je met mon sujet en résolu