XL 2013 Urgent Excel plzzzzzzzzzz

mohamedSCM · 2 Avril 2016

Bonjour à tous,

en fait je suis débutant sur le langage de VBA sur excel ...

jai le fichier (fichier_1) :

jai 1000 ligne dans ce fichier et je veux le diviser en plusieurs fichier de telle facon que

chaque fichier doit contenir 10 ligne.

MErci bq d'avance .

CPk · 2 Avril 2016

Re : Urgent Excel plzzzzzzzzzz

Bonjour, un premier jet

Code:

Sub decouper()
Application.ScreenUpdating = 0
k = 0
For i = 2 To Feuil1.UsedRange.Rows.Count Step 9
Workbooks.Add
a = ThisWorkbook.Sheets(1).Cells(i, 1).Resize(9, 3)
With ActiveSheet

.Cells(2, 1).Resize(9, 3) = a
.Cells(1, 1).Resize(1, 3) = ThisWorkbook.Sheets(1).Cells(1, 1).Resize(1, 3).Value
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "Fichier" & k
ActiveWorkbook.Close
k = k + 1
End With
Next
Application.ScreenUpdating = 1
End Sub

Robert · 2 Avril 2016

Re : Urgent Excel plzzzzzzzzzz

Bonjour le fil, bonjour le forum,

Sensiblement la même chose que Cpk... Comme je l'ai commenté je le met aussi.

Code:

Sub Macro2()
Dim CO As Workbook 'déclare la variable CO (Classeur d'Origine)
Dim CH As String 'déclare la variable CH (Chemin d'accès)
Dim OO As Worksheet 'déclare la variable OO (Onglet d'Origine)
Dim TV As Variant 'déclare la variable TV (Tableau des Valeurs)
Dim NL As Long 'déclare la variable NL (Nombre de Lignes)
Dim NC As Byte 'déclare la variable NC (CNombre de Colonnes)
Dim I As Integer 'déclare la variable I (Incrément)
Dim J As Integer 'déclare la variable J (incrément)
Dim K As Integer 'déclare la variable K (incrément)
Dim L As Byte 'déclare la variable L (incrément)
Dim CC As Workbook 'déclare la variable CC (Classeur Cible)
Dim OC As Worksheet 'déclare la variable OC (Onglet Cible)

Set CO = ThisWorkbook 'défint la variable CO
CH = CO.Path & "\" 'définit le chemin d'accès CH
Set OO = Sheets("said") 'définit l'onglet d'origine OO
TV = OO.Range("A1").CurrentRegion 'définit le tableau des valeurs TV
NL = UBound(TV, 1) 'définit le nombre de lignes NL du tableau des valeurs TV
NC = UBound(TV, 2) 'définit le nombre de colonnes NC du tableau des valeurs TV
I = 1 'initialise la variable I
J = 2 'initialise la variable J
For K = J To NL 'boucle de la ligne 2 à la dernière ligne NL
    Application.Workbooks.Add 'ouvre un classeur vierge
    Set CC = ActiveWorkbook 'définit le classeur cible CC
    CC.SaveAs CH & "Fichier_" & Format(I, "000") & ".xls", FileFormat:=xlOpenXMLWorkbookMacroEnabled 'enregistre le classeur cible CC
    Set OC = CC.Sheets(1) 'définit l'onglet cible OC
    OC.Name = "said_" & Format(I, "000") 'nomme OC
    OC.Range("A1").Resize(1, NC) = Application.Index(TV, 1) 'copie la première ligne du tableau des valeurs
    OC.Range("A2").Resize(10, NC) = OO.Range(OO.Cells(J, 1), OO.Cells(J + 10, NC)).Value 'copie les 10 lignes de la boucle
    CC.Close True 'ferme le classeur cible en enregistrant les modifications
    I = I + 1 'incrémente I
    J = J + 10 'incrémente J
Next K 'prochaine ligne de la boucle
End Sub

mohamedSCM · 2 Avril 2016

Re : Urgent Excel plzzzzzzzzzz

MErci bqqqqqqqqqqqqqqqqqqqqq

mohamedSCM · 2 Avril 2016

Re : Urgent Excel plzzzzzzzzzz

ca marche supéééééééééééééééér bien mais :

par exemple jai un fichier qui contient 101 ligne et dont pour diviser les ligne par 10
ca donne 10 fichier

dans ce cas la ton algoritme ma donner 2 types de fichier :

le premier avec le nom Fichier0 Fichier1 Fichier3 .... jusqua fichier11 ---> c'est ca ce que je veux
mais il me donne aussi un deuxième type avec le nom Fichier_001 .... jusqua Fichier_100 ---> je sais pas pk !!

pour moi il me suffit que le premier type du fichier.

MErci bqqq

mapomme · 2 Avril 2016

Re : Urgent Excel plzzzzzzzzzz

Bonjour à tous,

Un autre essai:

si un fichier existe déjà, il sera écrasé !
si vous ne voulez pas la fenêtre indiquant la progression, supprimez les instructions où figurent "Userform1"

Code dans module1:

VB:

Sub Division100()Dim Nouveau As Workbook, N&, i&, chemin$

Application.ScreenUpdating = False
chemin = ThisWorkbook.FullName
i = InStr(StrReverse(chemin), ".")
chemin = Left(chemin, Len(chemin) - i) & "-"
With ThisWorkbook.Worksheets("said")
  N = .Cells(.Rows.Count, "a").End(xlUp).Row
  If N Mod 10 = 1 Then N = N / 10 - 1 Else N = N / 10
  For i = 0 To N
    UserForm1.Show vbModeless: UserForm1.Label2 = i + 1: UserForm1.Label4 = N + 1
    DoEvents: DoEvents
    Set Nouveau = Workbooks.Add
    .Range("a1:c1").Copy Nouveau.Sheets(1).Range("a1")
    .Range("a1").Offset(1 + i * 10).Resize(10, 3).Copy Nouveau.Sheets(1).Range("a2")
    Application.DisplayAlerts = False
    Nouveau.SaveAs Filename:=chemin & Format(i + 1, "0000"), _
      FileFormat:=xlOpenXMLWorkbookMacroEnabled
    Nouveau.Close
    Application.DisplayAlerts = True
  Next i
End With
On Error Resume Next
Unload UserForm1
End Sub

mohamedSCM · 2 Avril 2016

Re : Urgent Excel plzzzzzzzzzz

chapeau bas mapomme ca marche supér bien

merci bqqqqqqqqqqqqqqqq

jp14 · 2 Avril 2016

Re : Urgent Excel plzzzzzzzzzz

Bonjour

Ci dessous une autre méthode.

Code:

Sub travdem()
Dim Ib As Byte, Nomfeuille1 As String, Col1 As String
Dim MonTab As Variant, Compt1 As Long, Deb As Long, Fin As Long
'parametre
Nomfeuille1 = ActiveSheet.Name
Col1 = "A"
Deb = 2 'première ligne avec les données
Fin = Deb + 10
'code
'creation de 10 feuilles
For Ib = 1 To 10
   ' création d'une feuille
    ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveSheet.Name = "Feuil" & Ib & "sur10"
    Sheets(Nomfeuille1).Rows(Deb & ":" & Fin).Copy Destination:=ActiveSheet.Range("a1")
    Deb = Fin + 1
    Fin = Fin + 10
'Création d'un classeur
    Sheets(Nomfeuille1).Activate
    Sheets("Feuil" & Ib & "sur10").Copy
    ActiveWorkbook.SaveAs Filename:= _
        "Feuil" & Ib & "sur10", _
        FileFormat:=xlNormal, Password:="", WriteResPassword:="", _
        ReadOnlyRecommended:=False, CreateBackup:=False
    ActiveWorkbook.Close
Next Ib
End Sub

Bonne journée

JP

CPk · 2 Avril 2016

Re : Urgent Excel plzzzzzzzzzz

mohamedSCM à dit:
ca marche supéééééééééééééééér bien mais :

par exemple jai un fichier qui contient 101 ligne et dont pour diviser les ligne par 10
ca donne 10 fichier

dans ce cas la ton algoritme ma donner 2 types de fichier :

le premier avec le nom Fichier0 Fichier1 Fichier3 .... jusqua fichier11 ---> c'est ca ce que je veux
mais il me donne aussi un deuxième type avec le nom Fichier_001 .... jusqua Fichier_100 ---> je sais pas pk !!

pour moi il me suffit que le premier type du fichier.

MErci bqqq

Message destiné à qui ?

mohamedSCM · 2 Avril 2016

Re : Urgent Excel plzzzzzzzzzz

merci bq jp14
ca marche trés bien

MErci a vous tous ....

bon weekend

CPk · 2 Avril 2016

Re : Urgent Excel plzzzzzzzzzz

Voici ma macro mise à jour qui modifie le nombre de fichier. Ce qui fait qu'ils ont désormais 11 lignes soit 10 lignes de noms + 1 ligne d'entête

Code:

Sub decouper()
Application.ScreenUpdating = 0
k = 1
For i = 2 To Feuil1.UsedRange.Rows.Count Step 10
Workbooks.Add
a = ThisWorkbook.Sheets(1).Cells(i, 1).Resize(10, 3)
With ActiveSheet

.Cells(2, 1).Resize(10, 3) = a
.Cells(1, 1).Resize(1, 3) = ThisWorkbook.Sheets(1).Cells(1, 1).Resize(1, 3).Value
ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & "Fichier" & k
ActiveWorkbook.Close
k = k + 1
End With
Next
Application.ScreenUpdating = 1
End Sub

mohamedSCM · 2 Avril 2016

Re : Urgent Excel plzzzzzzzzzz

Trop précis trop sympa

merci bq CPk

CPk · 2 Avril 2016

Re : Urgent Excel plzzzzzzzzzz

Pas de quoi. Besselem

Effectuez une recherche sur Excel Downloads...

XL 2013 Urgent Excel plzzzzzzzzzz

mohamedSCM

XLDnaute Nouveau

Pièces jointes

CPk

XLDnaute Impliqué

Robert

XLDnaute Barbatruc

mohamedSCM

XLDnaute Nouveau

mohamedSCM

XLDnaute Nouveau

mapomme

XLDnaute Barbatruc

Pièces jointes

mohamedSCM

XLDnaute Nouveau

jp14

XLDnaute Barbatruc

CPk

XLDnaute Impliqué

mohamedSCM

XLDnaute Nouveau

CPk

XLDnaute Impliqué

mohamedSCM

XLDnaute Nouveau

CPk

XLDnaute Impliqué

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums