Macro Ajout fichier

Bonjour,

j'ai mon macro qui marche bien. Il me permet de compier les données de mon fichier "DBAjoutFiche.xls" vers ma base de données "BDB.xls".

Mon probléme est qu'il me copie l'ensemble des cellule de B2:C40 même s'il existe des ligne vides or je veux copier que les ligne non vide.

Sub sauvegardeFiche2()
  Application.ScreenUpdating = False
  wSource = ThisWorkbook.Name
  sSource = ActiveSheet.Name
  rep = ThisWorkbook.Path
  Workbooks.Open Filename:=rep & "\" & "BDBase.xls"
  Sheets("BD").Select
  Workbooks(wSource).Sheets(sSource).[B2:C40].Copy
  [B2:C40].End(xlUp).Offset(1, 0).PasteSpecial , Transpose:=False
  ActiveWorkbook.Save
  ActiveWorkbook.Close
  [B2:C40].ClearContents
End Sub

Merci d'avance.

Bonjour sans les deux fichiers dont tu nous parles il nous est compliqué de te fournir un code VBA fonctionnel.

Pourrais-tu, mêmes si tu fausses les données car ces dernières peuvent être confidentielles, nous joindre ces deux fichiers ?

Sinon, si tu t'y connais un peu, je te propose de créer une code supprimant les lignes vide. Tu intègres ce code avant qu'Excel copie les données vers ta nouvelle base de données et le tour est joué

Cordialement,

Bonjour Greg,

J'ai joint le fichier.

Merci.

14bdajoutfiche.zip (19.54 Ko)

Bonjour,

Remplacer votre code VBA par celui-ci :

Sub sauvegardeFiche2()
    Récapitulatif
  Application.ScreenUpdating = False
  wSource = ThisWorkbook.Name
  sSource = ActiveSheet.Name
  rep = ThisWorkbook.Path
  Workbooks.Open Filename:=rep & "\" & "BDBase.xls"
  Sheets("BD").Select
  Workbooks(wSource).Sheets(sSource).[D2:E40].Copy
  [B2:C40].End(xlUp).Offset(1, 0).PasteSpecial , Transpose:=False
  ActiveWorkbook.Save
  ActiveWorkbook.Close
  [D2:E40].ClearContents
End Sub

Sub Récapitulatif()
Dlb = Feuil1.Range("B2000").End(xlUp).Row
Dld = Feuil1.Range("D2000").End(xlUp).Row

For J = 2 To Dlb
If Feuil1.Range("B" & J) > 0 Or Feuil1.Range("C" & J) > 0 Then
Feuil1.Range("D" & Dld) = Feuil1.Range("B" & J)
Feuil1.Range("E" & Dld) = Feuil1.Range("C" & J)
Dld = Dld + 1
End If

Next J

End Sub

Le code récapitulatif recopie dans un premier temps votre liste sans les lignes vides en colonne D et E. Ensuite ton code d'origine fait le reste du boulot.

Cordialement

bonjour Greg,

je l'ai tester mais ça marche pas.

Au passege je veudrais aussi integrer une fonction pour compier/coller valeurs comme exemple:

.Cells.Copy
           .Cells.PasteSpecial Paste:=xlPasteValues
           .Range("").Select

Quelle est l'erreur affichée par Excel ?

Je ne comprends pas, votre code d'origine réalisait déjà la fonction copier/coller... De plus le code que vous avez collé est incomplet....

Bonjour,

J'ai opter pour une solution moin simple que ce site m'a inspiré, la copie se fait sur le même classeur mais jarrive toujours pas à resoudre les problémes de copie/coller valeurs et ne pas copier les ligne vide.

Sub copie()
'Macro le 17/07/2013
Dim lg As Integer
Dim plage As Range
lg = Sheets("Base1").Range("A65536").End(xlUp).Row
Set plage = Sheets("Base").Range("B6:E" & Range("B65536").End(xlUp).Row)
plage.Copy Sheets("Base1").Range("A" & lg + 1)
End Sub

Merci d'avance

2actu.xlsm (47.98 Ko)

Bonjour,

Voilà qui est plus précis

Je t'ai aussi corrigé le code qui te permet de supprimer les informations : Celui-ci te supprimait les titres lorsqu'il n'y avait pas d'informations... Erreur corrigé avec le nouveau code.

6actu.xlsm (46.95 Ko)

C'est tt ce qu'il fallait faire.

Un grand merci Greg.

Rechercher des sujets similaires à "macro ajout fichier"