begin process at 2012 02 10 01:38:21
  Trouver un code source :
 
dans
 
Accueil > 

Code

 > 

VBScript

 > MACRO EXCEL POUR DÉPLACER LES CELLULES ENTRE FEUILLES

MACRO EXCEL POUR DÉPLACER LES CELLULES ENTRE FEUILLES


 Information sur la source

Note :
6 / 10 - par 1 personne
6,00 / 10

  • 1

  • 2

  • 3

  • 4

  • 5

  • 6

  • 7

  • 8

  • 9

  • 10
Catégorie :VBScript Niveau :Débutant Date de création :16/08/2004 Vu :10 929

Auteur : patou06

Ecrire un message privé
Commentaire sur cette source (1)
Ajouter un commentaire et/ou une note

 Description

J'ai réalisé ce code pour pouvoir copier toutes les lignes  de feuilles 1 à n et les coller vers une feuille qui sert d'archive. Toutes les lignes copiées sont supprimées pour libérer la feuille. Utiles lors d'un accés au fichier excel pour consulter les feuilles. La macro se lance à l'ouverture

Source

  • Public Sub Autoexec()
  • 'calcul du numéro de la premiere ligne vide
  • k = 1
  • Do While Worksheets(10).Cells(k, 1) <> ""
  • k = k + 1
  • Loop
  • For i = 2 To 9
  • J = 2
  • Do While Worksheets(i).Cells(J, 1) <> ""
  • If Worksheets(i).Cells(J, 2) < DateAdd("m", -1, Date) Then
  • Sheets(i).Select 'selection de la feuille
  • Range("A" & J & ":F" & J).Select 'selection des cellules
  • Selection.Copy 'copier la selection
  • Sheets(10).Select 'Feuille archive
  • Range("B" & k).Select 'selectionner la cellule de destination
  • ActiveSheet.Paste 'coller
  • Cells(k, 1) = Sheets(i).Name 'placer le nom de la feuille
  • k = k + 1
  • Worksheets(i).Rows(J).Delete
  • End If
  • J = J + 1
  • Loop
  • Next
  • End Sub
Public Sub Autoexec()
'calcul du numéro de la premiere ligne vide
k = 1
Do While Worksheets(10).Cells(k, 1) <> ""
k = k + 1
Loop
For i = 2 To 9
J = 2
Do While Worksheets(i).Cells(J, 1) <> ""
If Worksheets(i).Cells(J, 2) < DateAdd("m", -1, Date) Then
Sheets(i).Select 'selection de la feuille
Range("A" & J & ":F" & J).Select 'selection des cellules
Selection.Copy 'copier la selection
Sheets(10).Select 'Feuille archive
Range("B" & k).Select 'selectionner la cellule de destination
ActiveSheet.Paste 'coller
Cells(k, 1) = Sheets(i).Name 'placer le nom de la feuille
k = k + 1
Worksheets(i).Rows(J).Delete
End If
J = J + 1
Loop
Next
End Sub

 Conclusion

un grand merci à ShadowWisp pour ces conseils


 Sources de la même categorie

Source avec Zip Source avec une capture RECHERCHE & SAUVEGARDE DES FICHIERS PAR LEURS EXTENSIONS par hackoo
Source avec Zip Source avec une capture [VBS] SPLASH SCREEN EN VBSCRIPT par hackoo
Source avec Zip Source avec une capture [VBS] GOOGLE EASTER EGGS par hackoo
Source avec Zip Source avec une capture FILE2COMPARE: COMPARAISON DE DEUX FICHIERS LIGNE PAR LIGNE par hackoo
Source avec Zip Source avec une capture [VBS] COMMENT CRÉER UN DOSSIER ET LE PROTÉGER PAR MOT DE PAS... par hackoo

Commentaires et avis

Commentaire de clipper1 le 27/10/2008 21:54:15

je cherche un moteur de recherche sur excel

 Ajouter un commentaire




Nos sponsors


Sondage...

Comparez les prix

CalendriCode

Février 2012
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
272829    

Consulter la suite du CalendriCode

Photothèque

 
Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils.
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés

Google Coop CodeS-SourceS Google Coop CodeS-SourceS
Temps d'éxécution de la page : 0,374 sec (4)

Nous contacter | Annoncer sur CodeS-SourceS | Mentions légales