pb de copie en multi-workbooks:

[Alex]

Salut, Forum !
je n'ais pas reussit à copier une plage de cellules (fonction de i) provenant d'un autre classeur que le classeur actif (Thisworkbook)

'Programme Teste
'Classeur actif: Classeur1
'Classeur ou l'on veut copier la plage de cellules: Classeur2
'On écrit dans le classeur1:

Private Sub CommandButton1_Click()
Dim i As Integer
Dim j As Integer
Dim MyRangeAstuce As String
i = 1
j = 1

Workbooks(Classeur1).Worksheets(1).Activate
Worksheets(1).Range(Cells(1, i), Cells(57, i)).Copy 'Ca Marche (1)

Workbooks(Classeur2).Worksheets(1).Activate
Worksheets(1).Range(Cells(1, i), Cells(57, i)).Copy 'Ca plante (2)

Workbooks(Classeur2).Worksheets(1).Activate
Worksheets(1).Range("A1:C3").Copy 'Ca Marche (3)

MyRangeAstuce=CodeCellule(i,1) + ":" + CodeCellule(j,57)
Workbooks(Classeur2).Worksheets(1).Activate
Worksheets(1).Range(MyRangeAstuce).Copy 'Ca Marche (4)

End Sub


'J'ais fais une fonction qui me renvoie un string ex ("B12") en fonction de la ligne et de la colonne que je lui envoie:

Public Function CodeCellule(Colone As Integer, ligne As Integer) As String

Dim PosCaractére1 As Integer
Dim PosCaractére2 As Integer
Dim TableauAlphabet
TableauAlphabet = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y", "Z")

PosCaractére1 = Int(Colone / 26)

While Colone > 0
PosCaractére2 = Colone
Colone = Colone - 26
Wend

If PosCaractére1 = 0 Then
CodeCellule = TableauAlphabet(PosCaractére2 - 1) + CStr(ligne)
Else
CodeCellule = TableauAlphabet(PosCaractére1 - 1) + TableauAlphabet(PosCaractére2 - 1) + CStr(ligne)
End If

End Function


Il doit y avoir une autre facon de procéder sans passer par une function.

Aide Moi Forum !

Merci, Tchao.