"coller" sans ouvrir "etat"

Résolu

khbt Messages postés 13 Date d'inscription Statut Membre Dernière intervention -
khbt Messages postés 13 Date d'inscription Statut Membre Dernière intervention - 11 juil. 2006 à 22:06

voilà mon code , j'aime copier des cellules séparer du fichier" saisie" vers le fichier "etat", je réussi à le faire mais il y a l'ouverture du fichier "etat" à chaque copie et c'est génant, si c'est possible de me dire comment faire "coler" sans ouvrir le fichier "etat" à chaque fois.

Function DerLi()
Dim LastRow As Long
ActiveSheet.UsedRange
LastRow = Cells.SpecialCells(xlLastCell).Row
DerLi = LastRow
End Function
Sub Button2_Click()
Dim Sh As Worksheet
Dim Reponse As String
Dim MonNom As String
Dim BonNom As Boolean
Dim LeString
LeString = ":\/?*[]"
Workbooks.Open "d:\lazher\etat.xls"
Workbooks("etat.xls").Activate
Workbooks("etat.xls").Worksheets(Sheets.Count).Select
If (Sheets(Sheets.Count).Range("E" & DerLi()).Value <> " ") Then
Cells(DerLi(), 6).ClearContents
Cells(DerLi(), 5).ClearContents
Cells(DerLi(), 7).ClearContents
Cells(DerLi(), 8).ClearContents
Cells(DerLi(), 9).ClearContents
End If
Workbooks("etat.xls").Close True
If (Sheets(Sheets.Count).Range("A" & DerLi() - 2).Value <= 4) Then
Sheets("sheet1").Select
Range("B18").Select
Selection.Copy
Workbooks.Open "d:\lazher\etat.xls"
Workbooks("etat.xls").Activate
Workbooks("etat.xls").Worksheets(Sheets.Count).Select
Range("B" & DerLi() + 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("etat.xls").Close True
Sheets("sheet1").Select
Range("C1818").Select
Selection.Copy
Workbooks.Open "d:\lazher\etat.xls"
Workbooks("etat.xls").Activate
Workbooks("etat.xls").Worksheets(Sheets.Count).Select
Range("C" & DerLi()).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(Sheets.Count).Select
Range("C" & DerLi()).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Workbooks("etat.xls").Close True
Sheets("sheet1").Select
Range("B10:J14").Select
Selection.Copy
Workbooks.Open "d:\lazher\etat.xls"
Workbooks("etat.xls").Activate
Workbooks("etat.xls").Worksheets(Sheets.Count).Select
Range("D" & DerLi()).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(Sheets.Count).Select
Range("D" & DerLi()).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Workbooks("etat.xls").Close True
Sheets("sheet1").Select
Range("F18:J18").Select
Selection.Copy
Workbooks.Open "d:\lazher\etat.xls"
Workbooks("etat.xls").Activate
Workbooks("etat.xls").Worksheets(Sheets.Count).Select
Range("E" & DerLi()).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(Sheets.Count).Select
Range("E" & DerLi()).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Workbooks("etat.xls").Close True
Sheets("sheet1").Select
Range("K18").Select
Selection.Copy
Workbooks.Open "d:\lazher\etat.xls"
Workbooks("etat.xls").Activate
Workbooks("etat.xls").Worksheets(Sheets.Count).Select
Range("F" & DerLi()).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(Sheets.Count).Select
Range("F" & DerLi()).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Workbooks("etat.xls").Close True
Sheets("sheet1").Select
Range("L18").Select
Selection.Copy
Workbooks.Open "d:\lazher\etat.xls"
Workbooks("etat.xls").Activate
Workbooks("etat.xls").Worksheets(Sheets.Count).Select
Range("G" & DerLi()).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets(Sheets.Count).Select
Range("G" & DerLi()).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Range("A" & DerLi()).Value = Range("A" & DerLi() - 1).Value
With Sheets(Sheets.Count).Range("A" & DerLi())
.Value = .Value + 1
End With
Sheets(Sheets.Count).Select
Range("A" & DerLi()).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Sheets(Sheets.Count).Select
Range("H" & DerLi()).Select
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Sheets(Sheets.Count).Select
Range("I" & DerLi()).Select
Range("I" & DerLi()).Value = Range("F" & DerLi()).Value - Range("H" & DerLi()).Value
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
Range("E" & DerLi() + 2).Value = "Total"
Dim rg As Range
Dim rg1 As Range
Dim rg2 As Range
Dim rg3 As Range
Dim rg4 As Range
Set rg = ActiveSheet.Range(Cells(14, 6), Cells(DerLi() - 2, 6))
ActiveSheet.Cells(DerLi(), 6).Formula = "=SUM(" & rg.AddressLocal & " )"
Set rg1 = ActiveSheet.Range(Cells(14, 7), Cells(DerLi() - 2, 7))
ActiveSheet.Cells(DerLi(), 7).Formula = "=SUM(" & rg1.AddressLocal & " )"
Set rg2 = ActiveSheet.Range(Cells(14, 8), Cells(DerLi() - 2, 8))
ActiveSheet.Cells(DerLi(), 8).Formula = "=SUM(" & rg2.AddressLocal & " )"
Set rg3 = ActiveSheet.Range(Cells(14, 9), Cells(DerLi() - 2, 9))
ActiveSheet.Cells(DerLi(), 9).Formula = "=SUM(" & rg3.AddressLocal & " )"
Workbooks("etat.xls").Close True
End If
Workbooks.Open "d:\lazher\etat.xls"
Workbooks("etat.xls").Activate
Workbooks("etat.xls").Worksheets(Sheets.Count).Select
If Sheets(Sheets.Count).Range("A" & DerLi() - 2).Value >= 5 Then
Do
BonNom = True
Reponse = InputBox("Veuillez saisir le n°" _
+ vbCrLf + "du chéquier suivant", _
"N° du chéquier ", MonNom)
If Reponse <> "" Then
'Vérifier que le nom n'existe pas déjà...
For a = 1 To ActiveWorkbook.Worksheets.Count
If UCase(Reponse) = UCase(Worksheets(a).Name) Then
supp = MsgBox( _
"Vous possédez une feuille portant déjà ce nom," _
+ vbCrLf + vbCrLf + _
"Désirez-vous la remplacer?.", vbYesNo + vbOKOnly, _
"Nom existant déjà")
If supp = vbYes Then
Application.DisplayAlerts = False
Worksheets(Reponse).Delete
Application.DisplayAlerts = True
Exit For
Else
BonNom = False
MonNom = Reponse
Exit For
End If
End If
Next

'Vérifier que le nombre de caractères du nom ne dépassent 31...
If Len(Reponse) > 31 Then
MsgBox "Le nombre de caractères (" & _
Len(Reponse) & ") de votre nom dépasse" _
+ vbCrLf + " celui permis (31) par excel.", _
vbCritical + vbInformation, "Nom trop long"
BonNom = False
MonNom = Reponse
End If

'Vérifier l'emploi de caractères interdits...dans le nom
For a = 1 To Len(LeString)
If InStr(1, Reponse, Mid(LeString, a, 1), vbTextCompare) > 0 Then
MsgBox "Les caractères suivants: " & _
LeString & " sont interdits" _
+ vbCrLf + "dans le nom d'une feuille.", _
vbCritical + vbOKOnly, "Caractère interdit"
BonNom = False
MonNom = Reponse
Exit For
End If
Next
Else
Exit Sub
End If
Loop Until BonNom = True

Set Sh = Worksheets.Add(after:=Worksheets(Worksheets.Count))
Sh.Name = Reponse
Columns("A:A").ColumnWidth = 6.29
Columns("B:B").ColumnWidth = 14.86
Columns("C:C").ColumnWidth = 16
Columns("D").ColumnWidth = 16
Columns("E:E").ColumnWidth = 16
Columns("F:F").ColumnWidth = 8
Columns("G:G").ColumnWidth = 7.43
Columns("H:H").ColumnWidth = 16
Columns("I:I").ColumnWidth = 24
Cells.Select
Application.CutCopyMode = False
With Selection.Interior
.ColorIndex = 2
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
Sheets("Sheet1").Select
ActiveSheet.Shapes("Text Box 2").Select
ActiveSheet.Shapes.Range(Array("Text Box 2", "Picture 1")).Select
Selection.Copy
Sheets(Sheets.Count).Select
ActiveSheet.Paste
Sheets("Sheet1").Select
Range("A7:I12").Select
Selection.Copy
Sheets(Sheets.Count).Select
Range("A7").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Sheets("Sheet1").Select
Range("A13").Select
Selection.Copy
Sheets(Sheets.Count).Select
Range("A13").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
End If
Workbooks("etat.xls").Close True
End Sub

Afficher la suite

A voir également:

"coller" sans ouvrir "etat"
Comment ouvrir un fichier epub ? - Guide
Ouvrir fichier .bin - Guide
Ouvrir fichier .dat - Guide
Comment ouvrir un fichier docx ? - Guide
Ouvrir avec - Guide

6 réponses

Réponse 1 / 6

BmV Messages postés 92715 Date d'inscription Statut Modérateur Dernière intervention 4 849

Salut.

Ouais.
Ca beugue pas mal, en effet, chez toi.

Les fonctions "Bonjour" , "S'il vous plait" , "Merci d'avance" au moins semblent sérieusement endommagées....

A checker assez rapidement ...

Réponse 2 / 6

Armojax Messages postés 1860 Date d'inscription Statut Membre Dernière intervention 1 528

... si c'est possible de me dire comment faire "coler" sans ouvrir le fichier "etat" à chaque fois.

Réponse : en le laissant ouvert.

khbt Messages postés 13 Date d'inscription Statut Membre Dernière intervention

voilà j'ai trouvé une solution :
Range("A1:C1").Select

Réponse 3 / 6

khbt Messages postés 13 Date d'inscription Statut Membre Dernière intervention

mais ce que je veux c'est que le classeur "etat" lorsque je vais coller les valeurs de quelques cellules du classeur"saisie" , ne s'ouvre pas à chaque fois je fais coller .
pour "select" si je ne l'utilise pas je vais utiliser quoi exactement pour selectionner l'emplacement là où je vais coller, c'est sur il y a une autre astuce :
voilà un code simple : je suis dans la feuille de saisie (un claseur à part)
sub copie()
Sheets("sheet1").Select
Range("L18").Select
Selection.Copy
Workbooks.Open "d:\etat.xls"
Workbooks("etat.xls").Activate
Workbooks("etat.xls").Worksheets(Sheets.Count).Select
Range("G" & DerLi()).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("etat.xls").Close True
end sub
si tu affecte ce code à un bouton, tu vas remarquer qu'il ouvre le fichier etat et il colle la valeur et il ferme
ce fichier, si je vais coller plusieurs valeur séparement c'est genant cette ouverture recurrente du fichier"etat.xls"

Réponse 4 / 6

Armojax Messages postés 1860 Date d'inscription Statut Membre Dernière intervention 1 528

Hello,

Tu peux alléger considérablement ton code.

Tout d'abord, au lieu de faire des collages spéciaux, fais des collages tout court. Coller, sans aucune autre précision, colle tout : les valeurs, la police, la couleur, les bordures... Donc pas la peine de s'embêter avec du détail.

Ensuite, quand tu travailles sur deux classeurs, les commandes s'appliquent par défaut au classeur actif. Donc, au lieu d'ouvrir et de fermer ton classeur à tout bout de champ, il suffit de faire un activate du classeur sur lequel tu veux travailler.

Plus simple encore, tu donnes un nom à tes classeurs,

Dim Orig As Workbook, Dest As Workbook

Ensuite, si tu préfixes tes commandes avec le nom de tes classeurs, tu n'as même pas besoin d'activer quoi que ce soit...

khbt Messages postés 13 Date d'inscription Statut Membre Dernière intervention

"Ensuite, si tu préfixes tes commandes avec le nom de tes classeurs, tu n'as même pas besoin d'activer quoi que ce soit..."

ta réponse est trrrrrrrrrès intéressente, pourrai je avoir plus de détail s'il vous plait.

Vous n’avez pas trouvé la réponse que vous recherchez ?

Posez votre question

Réponse 5 / 6

Armojax Messages postés 1860 Date d'inscription Statut Membre Dernière intervention 1 528

Je te joins un petit exemple là :

https://www.cjoint.com/?hgiqCfhHBH

La macro CopiesMultiples :
- affiche une boite de dialogue déplaçable, qui permet de sélectionner des plages de cellules (pour sélectionner des plages disjointes, sélectionner la première plage, puis maintenir enfoncée la touche CTRL pour sélectionner les suivantes).
- ouvre un classeur existant (pour mon test : D:\Armojax\khbt_2.xls, à toi d'adapter)
- efface la feuille Feuil1 de ce classeur (à adapter aussi)
- copie dans ce classeur les plages sélectionnées
- ferme et renvoie ce classeur.

Commentaires :
- la sélection multiple renvoie Champs(Range), qui est une suite de Plages (Areas). Une fois que c'est défini, VBA sait que ça se situe dans le classeur qui contient la macro.
- quand on ouvre le classeur dans lequel on fera la copie, il devient le classeur actif. Sheets("Feuil1").Activate concerne donc ce classeur. Et Cells.Clear concerne les cellules de cette feuille.

Pendant toute la boucle, le classeur de destination reste actif.

khbt Messages postés 13 Date d'inscription Statut Membre Dernière intervention

Merci infinement,
c'est très pratique comme solution mais ce que je veux qu'en cliquant sur un bouton il copie des cellules bien définies dans une ligne d'un autre classeur.

J'ai une feuille ( interface ) de saisie qui permet de copier les données saisies dans l'état, c'est pour une gestion de trésorerie.

Merci une autre fois mais malheureusment j'ai pas verifier le forum depuis, pardon Mr Armojax, j'espère recevoir une réponse.

Réponse 6 / 6

Armojax Messages postés 1860 Date d'inscription Statut Membre Dernière intervention 1 528

Salut,

De deux choses l'une :
soit les cellules que tu veux modifier dans ton classeur Etat doivent en permanence être à jour à partir des données de ton classeur Saisie, auquel cas des liaisons classiques peuvent suffire,

soit la mise à jour se fait quand tu le décides, en cliquant sur ton bouton, auquel cas une petite macro de ce style suffit :

Sub CopieCellules()

  Dim ClasseurSource As Workbook
  
  Set ClasseurSource = ThisWorkbook ' le classeur "Saisie"
  Workbooks.Open Filename:="D:\Etat.xls"  ' le classeur "Etat"
  Sheets("Feuille de destination").Activate ' préciser la feuille du classeur "Etat"
  
  ' ici on affecte les valeurs aux cellules...... (ligne 4 pour exemple)
  Range("C4").Value = ClasseurSource.Sheets("Feuil1").Range("A7").Value
  Range("D4").Value = ClasseurSource.Sheets("Feuil3").Range("J11").Value
  '...../.... etc........
  
  ActiveWorkbook.Close True
  
End Sub

khbt Messages postés 13 Date d'inscription Statut Membre Dernière intervention

bonsoir,
s'il vous plait j'ai un autre souci, si tu peux m'aider. tu trouve mon message.

Discussions similaires

dessin avec symbole clavier

L'état actuel de votre carte sim ne requiert aucune activation

Votre réponse

Discussions similaires