Reorganiser sa feuille excel de maniére automatique

Résolu/Fermé
pwskeud Messages postés 2 Date d'inscription jeudi 17 août 2017 Statut Membre Dernière intervention 17 août 2017 - 17 août 2017 à 11:59
pwskeud Messages postés 2 Date d'inscription jeudi 17 août 2017 Statut Membre Dernière intervention 17 août 2017 - 17 août 2017 à 15:08
Bonjour a tous,

Dans le cadre de mon travail je dois réorganiser chaque jour des données que je recois sur une feuille excel; ce travail est chronophage, fastidieux et ininteressant.
Les données que je recois sont toujours organisées de la meme maniere. Voila ce que je dois faire dans l'ordre chronologique :

copier la colonne 10 pour la coller sur une nouvelle feuille en colonne 1
copier la colonne 2 et 3 pour la coller sur la nouvelle feuille en colonne 2 et 3
copier la colonne 13 '' '' '' 4
'' '' 24 " " " 5
" " 11 " " 6
copier la colonne 21 pour la coller sur la nouvelle feuille en colonne 7
trier ensuite la nouvelle feuille dans l'ordre décroissant en fonction de la colonne 6.

Je commence a peine a travailler avc excel donc soyez clément avec moi dans vos explications.

pour résoudre ce probleme, j'ai essayé de m'initier au VBA et j'ai commencé a réaliser le programme suiant :
Sub CopierDonnees()

Dim Entree As Workbook, Sortie As Workbook

Nomfichierentree = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")
' On verifie que l'on a selectionné un nom de classeur
If Nomfichierentree <> False Then
' On ouvre le classeur
Set Entree = Workbooks.Open(Nomfichierentree)


NomFichierSortie = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")
If NomFichierSortie <> False Then
Set Sortie = Workbooks.Open(NomFichierSortie)

' Ici j'ai du commnce a mettre cellule par cellule car je ne sais pas comment le faire avec toute une colonne
Sortie.Worksheets("Feuil1").Cells(2, 1) = Entree.Worksheets("Feuil1").Cells(2, 10)
Sortie.Worksheets("Feuil1").Cells(3, 1) = Entree.Worksheets("Feuil1").Cells(3, 10)
Sortie.Worksheets("Feuil1").Cells(4, 1) = Entree.Worksheets("Feuil1").Cells(4, 10)



' On ferme le classeur
Sortie.Close


End If
' On ferme le second
Entree.Close
End If

Vous comprendrez que je me tourne vers vous car tel que j'ai commencé ca va etre chaud je crois ^^ en plus j'ai un probleme, le contenu de certaines cellules est une date et quand je fais le transfert via le VBA ca me donne une suite de chiffres qui n'a pas de sens...

Merci beaucoup pour l'aide que vous pourrez m'offrir !
A voir également:

1 réponse

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 776
Modifié le 17 août 2017 à 14:43
Bonjour,

Essaies ce code :
Option Explicit
Sub CopierDonnees()
Dim Source As Workbook
Dim Sortie As Workbook
Dim Entree As Range
Dim NomSource As Variant
Dim Colonnes As Variant
Dim Colonne As Integer

  'On définit l'ordre de copie des colonnes
  Colonnes = Array(, 10, 2, 3, 13, 24, 11, 21)
  ' On choisit le fichier d'entrée
  NomSource = Application.GetOpenFilename("Fichier Excel (*.xls), *.xls")
  ' On verifie que l'on a selectionné un nom de classeur
  If NomSource = False Then Exit Sub
  ' On ouvre le classeur source
  Set Source = Workbooks.Open(NomSource)
  ' On définit la plage d'entrée
  Set Entree = Source.Worksheets(1).UsedRange.EntireRow
  ' On crée un fichier de sortie
  Set Sortie = Workbooks.Add(xlWBATWorksheet)
  With Sortie.Worksheets(1)
    For Colonne = 1 To UBound(Colonnes)
      ' On copie chaque colonne
      Entree.Columns(Colonnes(Colonne)).Copy .Cells(1, Colonne)
    Next Colonne
    ' On trie d'après la colonne 6
    Colonne = 6
    .Range("A1").CurrentRegion.Sort Key1:=.Cells(2, Colonne), _
                               Order1:=xlAscending, Header:=xlYes
  End With
  ' On ferme le fichier source
  Source.Close

End Sub



Cordialement
Patrice
0
pwskeud Messages postés 2 Date d'inscription jeudi 17 août 2017 Statut Membre Dernière intervention 17 août 2017
17 août 2017 à 15:08
Merci Patrice, tu es TOP !

Ton programme est trés clair et bien détaillé!

J'ai compris la création de variable grace a toi! J'y ai apporté une légere amélioration en utilisant la fonction THISWORKBOOK a la place du Set Entrée ce qui évite d'ouvrir un fichier supplémentaire!

encore un grand merci, j'ai gagné bien des heures grace a toi !
0