modification macro

guigui76 · 9 Février 2010

Bonjour, je souhaite modifier cette macro

HTML:

http://www.excel-downloads.com/forum/91261-vba-excel-copier-une-colonne-en-fonction-dune-cellule.html

pourque je puisse faire une selection d'une plage de cellule au lieu de la colonne entiere.

je fais une translation par la suite.

Code:

sub cinq()
Dim celle As Range

For Each celle In Range("e4:ai4")
If celle.Value = 5 And celle.Value <> "" Then
[COLOR="Red"]celle.EntireColumn.Copy [/COLOR]'ici tu écris la cellule de destination
celle.select
End If
Next
End Sub

Je vous remercie

Staple1600 · 14 Février 2010

Re : modification macro

Bonjour à tous

Personnellement j'écrirai ceci

Code:

Sub Macro6bis()
Dim Source As Range, Desti As Range
Dim i As String
Dim x As Range
' Macro enregistrée le 27/01/2010 par Moi
i = Range("f19").Value
d = Range("i19").Value

comme cela

Code:

Sub Macro6bis()
Dim Source As Range, Desti As Range
Dim i As [COLOR=Red]String[/COLOR]
Dim d As [COLOR=Red]String[/COLOR]
Dim x As Range
' Macro enregistrée le 27/01/2010 par Moi
i = Range("f19").[COLOR=Red]Text[/COLOR]
d = Range("i19").[COLOR=Red]Text[/COLOR]

guigui76 · 14 Février 2010

Re : modification macro

Pierrot93 à dit:
Bonjour guigui

pour les selectionner, pas de problème :

Code:

Range("C2,C241:C500").Select

bon dimanche
@+

Mais je parlai avec le resultat de la recherche "x"
j'ai trouvé une solution:
je copie d'ensemble de la colonne de la ligne 2>500, vers le fichier destination
et ensuite je divise en plusieur entitée.
la premiere partie sur la premiere feuille et la deuxieme parti sur le deuxieme feuille.
Mais cela doit vous faire bondir comme solution.

guigui76 · 14 Février 2010

Re : modification macro

Staple1600 à dit:

Bonjour à tous

Personnellement j'écrirai ceci

Code:

Sub Macro6bis()
Dim Source As Range, Desti As Range
Dim i As String
Dim x As Range
' Macro enregistrée le 27/01/2010 par Moi
i = Range("f19").Value
d = Range("i19").Value

comme cela

Code:

Sub Macro6bis()
Dim Source As Range, Desti As Range
Dim i As [COLOR=Red]String[/COLOR]
Dim d As [COLOR=Red]String[/COLOR]
Dim x As Range
' Macro enregistrée le 27/01/2010 par Moi
i = Range("f19").[COLOR=Red]Text[/COLOR]
d = Range("i19").[COLOR=Red]Text[/COLOR]

je n'avais pas vu mon erreur😀.
je te remercie.

Pierrot93 · 14 Février 2010

Re : modification macro

Re

euh, vois pas trop ce que tu veux faire, pour info "x" étant une variable de type "range", tu peux essayer d'utiliser les propriété "row" ou "Column" pour déterminer une autre plage :

Code:

Range("C" & x.Row).Select

@+

guigui76 · 14 Février 2010

Re : modification macro

en faite, je desire copie les lignes 2>250 et les translaté vers un autre fichier dans la 1ere feuille , et copié la ligne 2 & 251>500 vers la deuxieme feuille du fichier destination.
la colonn etant trouvé par la recherche.

guigui76 · 14 Février 2010

Re : modification macro

donc cela pourrai donné cela

Code:

range(x.column & "2",x.column &"12":x.column&"280").select

Pierrot93 · 14 Février 2010

Re : modification macro

Re,

attention "x.column" va te renvoyer un numéro, essaye en utilisant "cells" à la place de "range"...

Pierrot93 · 14 Février 2010

Re : modification macro

Re

essaye peut être ainsi, non testé...

Code:

Union(Cells(2, x.Column), Range(Cells(12, x.Column).Address & ":" & Cells(280, x.Column).Address)).Select

Pierrot93 · 14 Février 2010

Re : modification macro

Re

en un peu plus court :

Code:

Union(Cells(2, x.Column), Cells(12, x.Column).Resize(269, 1)).Select

guigui76 · 14 Février 2010

Re : modification macro

Je te remercie Pierrot93 le code fonctionne bien mais il va falloir indiquer aussi dans la parti "coller" les numeros de lignes de destination.

Code:

If Not x Is Nothing Then
Union(Cells(2, x.Column), Cells(12, x.Column).Resize(26, 1)).Select
    
    Destination.Sheets("feuil1").Range("c65536").End(xlUp)(2).PasteSpecial xlPasteAll, xlNone, , True
End If

si cela te semble impossible, je ferai ma solution evoqué précedement

Pierrot93 · 15 Février 2010

Re : modification macro

Bonjour Guigui

oui... mais les coller où ? à partir de quels critères ? sinon ceci devrait fonctionner :

Code:

If Not x Is Nothing Then
    Union(Cells(2, x.Column), Cells(12, x.Column).Resize(26, 1)).Copy
    Destination.Sheets("feuil1").Range("c65536").End(xlUp)(2).PasteSpecial xlPasteAll, xlNone, , True
End If

bonne journée
@+

guigui76 · 15 Février 2010

Re : modification macro

Mille excuse, j'ai dit une bétisse de plus.

guigui76 · 15 Février 2010

Re : modification macro

Voila, je pense avoir fini:
Pour rappel :

_ le fichier general.xls indique, la date la source et la destination.

Je remercie toutes les personnes qui ont pu m'aider.

Code:

Sub Macro1()


Dim Source As Range, Desti As Range
Dim i As String
Dim d As String
Dim x As Range


' Macro enregistrée le 27/01/2010 par Moi


i = Range("f3").Value ' recherche du lieu et du nom du fichier source
d = Range("h3").Value ' recherche du lieu et du nom du fichier destination


Set Destination = Application.Workbooks.Open(d, , False)   ' ouverture du fichier destination
Set classeurSource = Application.Workbooks.Open(i, , True) ' ouverture du fichier source

'recherche de la valeur dans le fichier source
With classeurSource.Sheets("feuil1")
Set x = .Range("E2:AN2").Find(Workbooks("bilan general.xls").Sheets("feuil1").Range("B5").Value _
    , , xlValues, xlWhole, , , False)
End With

If Not x Is Nothing Then
'copie de le recherche vers la 1ere feuille ;la ligne 2 et de la ligne 3:255
    Union(Cells(2, x.Column), Cells(3, x.Column).Resize(252, 1)).Copy
    Destination.Sheets("feuil1").Range("c65536").End(xlUp)(2).PasteSpecial xlPasteAll, xlNone, , True
    
  'copie de la recherche vers la 2eme feuille ;la ligne 2 et de la ligne 256:511
Union(Cells(2, x.Column), Cells(255, x.Column).Resize(252, 1)).Copy
    Destination.Sheets("feuil2").Range("c65536").End(xlUp)(2).PasteSpecial xlPasteAll, xlNone, , True
End If

Application.DisplayAlerts = False
classeurSource.Close False ' fermeture du classeur source

Destination.Save 'sauvegarde du fichier destination
Destination.Close False 'fermeture du fichier destination
Application.DisplayAlerts = True ' arret des ala



End Sub

guigui76 · 17 Février 2010

Re : modification macro

Je reviens encore à la charge, mais je voudrai savoir:

si il y a possibilité d'avoir le fichier destination en lecture seule en temps normale et de retiré la protection lors de l'activation de la macro.

Code:

Set Destination = Application.Workbooks.Open(d, , , WriteResPassword:="1111",false)

erreur de compilation
attendu: parametre nommé

Pierrot93 · 17 Février 2010

Re : modification macro

Bonjour Guigui

essaye le code ci-dessous, chemin et nom fichier à adapter :

Code:

Dim destination As Workbook
Set destination = Workbooks.Open("C:\MesDocs\Excel\Test\classeur1.xls", , , , , "1111", True)

bon après midi
@+

modification macro

guigui76

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

guigui76

XLDnaute Occasionnel

guigui76

XLDnaute Occasionnel

Pierrot93

XLDnaute Barbatruc

guigui76

XLDnaute Occasionnel

guigui76

XLDnaute Occasionnel

Pierrot93

XLDnaute Barbatruc

Pierrot93

XLDnaute Barbatruc

Pierrot93

XLDnaute Barbatruc

guigui76

XLDnaute Occasionnel

Pierrot93

XLDnaute Barbatruc

guigui76

XLDnaute Occasionnel

guigui76

XLDnaute Occasionnel

guigui76

XLDnaute Occasionnel

Pierrot93

XLDnaute Barbatruc

Discussions similaires

modification macro

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Barbatruc

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Occasionnel

XLDnaute Barbatruc

Discussions similaires

Privacy & Transparency

Privacy & Transparency