excel vba : transfert de certaine cellule dans plusieurs feuilles differentes

[eden3]

bonjour,
j'essaye de faire un code depuis plusieurs mais je rencontre quelques difficultés:
je part d'un tableau excel avec un certain nombre de lignes et de colonnes et je souhaite sélectionner certaines lignes pour les mettre dans une nouvelle feuille que je renomme ( faire cela pour plusieurs ligne et dans des feuilles différentes) , après ca je veux suprimer certaines colonnes ).
j'ai fais le code avec insertion de deux feuilles pour commencer seulement j'ai des erreurs dont :" l'indice n'appartient pas à la selection" je n'arrive pas a comprendre ce qui ne vas pas et ca m'empêche d'avancer , je debute en vba .
voici le code :

 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)
        
        Dim nouvelle_feuille As Worksheet
        Set nouvelle_feuille = Worksheets.Add

       nouvelle_feuille.Name = "caution"

       Set nouvelle_feuille = Worksheets.Add

       nouvelle_feuille.Name = "incendie"

       Set nouvelle_feuille = Nothing
       Worksheets("Feuil1").Range("4:6").Copy After:=Worksheets("Feuil2").Cells
       'ici un message d'erreur apparait "l'indice n'appartient pas à la sélection"
       Sheets("incendie").Cells.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
       Columns("2:4").Select

       Range("A4").Activate

       Selection.Delete Shift:=xlUp




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

merci beaucoup pour vos reponses

Edit modération: Merci d'utiliser les balises "code" (je les ai rajoutées ici pour toi)

 

[Jerome MULDER]

Bonjour,

Je pense que tu ne "situes" pas assez ces éléments:
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)
end if

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

'active le 1er classeur nommé Entrée, sinon tu ne sais pas où tu travailles.
Entree.Activate

Dim nouvelle_feuille As Worksheet
' Set nouvelle_feuille = Worksheets.Add

' nouvelle_feuille.Name = "caution"

'Préfère plutot ceci pour les ajouts et noms de feuilles:

Sheets.Add After:=Sheets(Sheets.Count) ' cette instruction ouvre une nouvelle feuille après celles qui existent déjà. Il y a par defaut 3 1ere feuil de créé !!
ActiveSheet.Name = "caution"

' Set nouvelle_feuille = Worksheets.Add
Sheets.Add After:=Sheets(Sheets.Count) ' cette instruction ouvre uen nouvelle feuille après celles qui existent déjà
ActiveSheet.Name = "incendie"

' nouvelle_feuille.Name = "incendie"

' Set nouvelle_feuille = Nothing a quoi sert ce truc ???

' dans la même optique que d'appeler un classeur pour situer ton travail, tu dois appeler ta feuille pour situer au VBA où tu vas travailler
' de quel classeur s'agit-il ??
' admettons que ce soit Entree: aucun changement de "lieu" de travail. Sinon faire un SORTIE.activate

'Tu as une erreur ici car tu ne dois pas utiliser les chiffres comme avec Cell; mais les noms de lignes/colonnes !

Worksheets("Feuil1").Range("D,F:F").Copy Worksheets("Feuil2").Range("A1")
' Worksheets("Feuil1").Range("4:6").Copy After:=Worksheets("Feuil2").Cells
'ici un message d'erreur apparait "l'indice n'appartient pas à la sélection"

'Tu dois spécifier la feuille a activer en 1er.
Sheets("incendie").Select
Sheets("incendie").Cells.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

'Même erreur qu'au dessus... De plus, je ne sais plus ce que tu veux faire à partir de là. Désolé.
' Columns("B:B,D").Select

' Range("A4").Activate

' Selection.Delete Shift:=xlUp


'Si je reprends ton énoncé, tu dois copier les données de caution vers incendie ? et deleter certaines colonnes.
'voici des inddices
'copions ce qui nous interesse sur la feuille caution
Columns("B:B,D").Select
Selection.Copy

'je change de classeur pour utiliser SORTIE
SORTIE.Activate
Sheets("Feuil1").Activate

'je change de nom les feuilles 1 et 2
Sheets("Feuil1").Name = "caution"
Sheets("Feuil2").Activate
Sheets("Feuil2").Name = "incendie"
Columns("A:B").Select
ActiveSheet.Paste

'on ferme les classeurs
Set entree = Nothing
Set sortie = Nothing


' Petite macro pour supprimer des feuilles:que tu appeleras comme ceci:

Call Raz

End Sub

Sub Raz()
Application.DisplayAlerts = False
If sheetExist("Saisie") Then ' si la feuilel saisie existe je la supprime
Sheets("Saisie").Delete 'suppression de la feuille saisie
End If
If sheetExist("TEMP") Then
Sheets("TEMP").Delete
End If
If sheetExist("TDC") Then
Sheets("TDC").Delete
End If
If sheetExist("Feuil2") Then
Sheets("Feuil2").Delete
End If
If sheetExist("Feuil3") Then
Sheets("Feuil3").Delete
End If

Application.DisplayAlerts = True

MsgBox "Traitement terminé !"

End Sub

 

[eden3]

bonjour,
merci beaucoup pour la reponse ,
j'ai compris tout ce que tu m'as explique ,
seulement,
je me suis peut etre mal exprimée, quand tu me dis "je ne sais plus ce que tu veux faire à partir de là " , en realite je veux juste sur incendie par exemple suprimer certaine colonne
pour la feuille caution je fais refaire la meme demarche en selectionant d'autre ligne mais je suprimerais les meme colonnes
je voulais au debut selectioner pour chaque "nouvelle feuille" les lignes corespondent ( il n'y a pas que incendie et caution mais beaucoup d'autre) et ensuite suprimer les colonnes , mais sachant que c'est les meme colonnes a suprimer a chaque fois je me demande si c'est pas mieux que je commence par copier ma feuille entièrement suprimer les collones puis ouvrir mes nouvelles feuilles et copier les lignes quil me faut .

desole si je ne suis pas tres claire
je vais essayer de refaire un code a partir de ce que tu m'as dit et le poster ensuite
merci en tout cas!!!

 

[eden3]

je ne comprends pas juste quand tu as dis je dois donner des noms mais si je veux copier des ligne comment je conais les noms des lignes ?( c'est peut etre une question bete desole d'avance)

 

[eden3]

j'ai reecris mon code enessayant de faire au plus simple pour eviter qu'il me mette trop d'erreur , j'ai commence par une seuille feuille pour vir si au moins ca marchais seulement j'ai encore des erreur : eurreur automation au niveau du Entree.activate.
je ne comprends pas pourqoi


[cpp]
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)
End If
NomFichierSortie = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")
If NomFichierSortie <> False Then
Set Sortie = Workbooks.Open(NomFichierSortie)
End If
Entree.Activate
Worksheets("Feuil1").Copy After:=Worksheets("Feuil3")
Columns("C:C").Delete Shift:=xlToLeft

Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "caution"
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "incendie"


Worksheets("Feuil1").Range("D,F:F").Copy After:=Worksheets("Feuil2").Range("A1")

End Sub
[/cpp]

mercii pour vos reponses

 

[eden3]

rebonjour , je pense finalement avoir trouvé merci beaucoup!!!

 

[eden3]

j'ai juste toujours ma question sur comment savoir une ligne correspond a quelle lettre je travail sur des tableaux avec plus de 2000 lignes...

 

[eden3]

desole de revenir a la charge ,
seulement j'ai teste mon code sur un mini tableau d'essai et cela marchait
et quand je le teste sur le vrai tableau ca ne marche pas je ne comprend pas pourquoi je copie colle le code
il me met toujours la meme erreur 9 l'indice n'appartient pas a la selection
je ne sais plus quoi faire!!
[cpp]

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)
End If
NomFichierSortie = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")
If NomFichierSortie <> False Then
Set Sortie = Workbooks.Open(NomFichierSortie)
End If
Entree.Activate

Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "Feuil2"
Worksheets("Report").Copy Worksheets("Feuil2").Range("A1")
Columns("D").Delete Shift:=xlToLeft

Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "chantier"


Worksheets("Feuil1").Range("1:1,1324:1475").Copy Worksheets("chantier").Range("A1")

Sheets("Feuil2").Select
ActiveWindow.SelectedSheets.Delete



End Sub
[/cpp]

 

[zeb]

Salut,

Trop d'activeTruc, de select machin.
Ne pas faire confiance à ce qui est sélectionné !

Au contraire, précise à chaque fois ce sur quoi tu veux agir.
C'est plus lourd à écrire, mais il n'y a plus d'approximation.

Bon, je récris ton code :

Dim Entree           As Workbook,
Dim Sortie           As Workbook
Dim NomFichierEntree As String
Dim NomFichierSortie As String
Dim Feuille2         As Worksheet
Dim FeuilleChantier  As Worksheet

NomFichierEntree = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")
If Not NomFichierEntree Then Exit Sub
NomFichierSortie = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")
If Not NomFichierSortie Then Exit Sub

Set Entree = Workbooks.Open(NomFichierEntree)
Set Sortie = Workbooks.Open(NomFichierSortie)

Entree.Activate

Entree.Worksheets.Add After:=Worksheets(Worksheets.Count)
Set Feuille2 = Entree.Worksheets(Worksheets.Count)
Feuille2.Name = "Feuil2"

Entree.Worksheets("Report").Cells.Copy Feuille2.Range("A1")

Feuille2.Columns("D:D").Delete Shift:=xlToLeft

Entree.Worksheets.Add After:=Entree.Worksheets(Entree.Worksheets.Count)
Set FeuilleChantier = Entree.Worksheets(Entree.Worksheets.Count)
FeuilleChantier.Name = "chantier"
Entree.Worksheets("Feuil1").Range("1:1,1324:1475").Copy FeuilleChantier.Range("A1")

Feuille2.Delete

M'ouhais :/
Je me demande pourquoi on ouvre deux classeurs, pourquoi on crée une feuille pour la supprimer, etc.
Bon et maintenant, à quel endroit se produit l'erreur ?

 

[eden3]

bonjour,
je m'etais tres mal explique j'en suis desole , la reponse aporter par jerome m'a aide a aranger le code
ainsi apres plusieur heures voir jour de reflexion je suis finalement arrive a quelque chose de plus "propre" et plus claire cependant etant novice je ne sais pas encore faire plusieurs chose avec vba
j'aimerais que l'execution du code prenne moins de temps est ce possible ?
de plus au final , le code me redonne des chiffre a virgule alors que jaurais aimer des entier
et je voulais mettre des tiret (-) ou il y'a des 0 et des cellules vide mais cela ne marche pas je pense que c'est pcq il n'y a pas de bordure dans mes cellule j'aimerais les rajouter mais je ne sais pas si cela est possible
je vous renvoie le code pour vous montrer au cas ou mes explication ne sont pas tres claire
[cpp]
Sub CopierDonnees()

Dim Entree As Workbook,
Dim Sortie As Workbook
Dim NomFichierEntree As String
Dim NomFichierSortie As String
Dim FeuilleChantier As Worksheet

Nomfichierentree = Application.GetOpenFilename("Fichier Excel (*.xls), *.xsl")

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



'Worksheets("Report").Copy After:=Sheets(Worksheets.Count)
'Columns("C:C").Delete Shift:=xlToLeft

Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "chantier"


Worksheets("Report").Range("1:1,1324:1475").Copy Worksheets("chantier").Range("A1")

Dim i As Long

Dim j As Long

Dim n As Long
For j = 4 To 7
For i = 2 To 20
With Worksheets("chantier")
.Cells(i, j).Value = .Cells(i, j).Value + .Cells(i + 76, j).Value
.Cells(i + 19, j).Value = .Cells(i + 19, j).Value + .Cells((i + 19) + 76, j).Value
.Cells(i + 38, j).Value = .Cells(i + 38, j).Value + .Cells((i + 38) + 76, j).Value
.Cells(i + 57, j).Value = .Cells(i + 57, j).Value + .Cells((i + 57) + 76, j).Value
End With
Next i
Next j
For j = 8 To 19
n = 27 - j
For i = 2 To n
With Worksheets("chantier")
.Cells(i, j).Value = .Cells(i, j).Value + .Cells(i + 76, j).Value
.Cells(i + 19, j).Value = .Cells(i + 19, j).Value + .Cells((i + 19) + 76, j).Value
.Cells(i + 38, j).Value = .Cells(i + 38, j).Value + .Cells((i + 38) + 76, j).Value
.Cells(i + 57, j).Value = .Cells(i + 57, j).Value + .Cells((i + 57) + 76, j).Value
End With
Next i
Next j

Worksheets("chantier").Range("A78:Y153").Select
Selection.EntireRow.Delete

Selection.Replace what:="", replacement:="-"
Selection.Replace what:="0", replacement:="-"
'cela ne marche pas sur mes cellule sans bordure , mais le fait sur toute les autre cellules
' Sheets("Report (2)").Select
' ActiveWindow.SelectedSheets.Delete



End Sub
[/cpp]
merci beaucoup pour vos reponses et votre temps