ciao a tutti sn Amleto e sn tornato con un nuovo problema...utilizzo da tempo due macro Copia celle e Copia range. La prima macro "copia celle"è questa:
Sub CopiaCelle()
Dim col As Integer
col = 0
For Each c In Selection
col = col + 1
If col > 5 Then Exit Sub
Cells(1, col) = c.Value
Next
End Sub
che permette di copiare le celle selex nelle celle fisse A1:E1 (A1,B1,C1,D1,E1)
La seconda macro "Copia range" è questa
Public shUltimoFoglio As Worksheet
Sub CopiaRange()
Dim riga() As Variant
Dim Colonna As Long
Dim shF1 As Worksheet
Application.ScreenUpdating = False
Set shF1 = Worksheets("Foglio1")
shF1.Select
Set rng = Selection
Selection.Copy Destination:=Sheets("foglio2").Range("a5000")
col = 1
celcount = Range(Cells(1, 1), Cells(1, 1).End(xlToRight)).Count
ReDim riga(celcount)
For ic = 0 To celcount
riga(ic) = Cells(1, col).Value
col = col + 1
Next
Sheets("foglio2").Select
Range("a5000").CurrentRegion.Select
For i = LBound(riga) To UBound(riga) - 1
Colonna = fnFineCol(riga(i))
Fr = Selection.Row
Fc = Selection.Column
Ur = Selection(Selection.Count).Row
Uc = Selection(Selection.Count).Column
For nr = Fr To Ur
Range(Cells(nr, Fc), Cells(nr, Uc)).Copy Destination:=shUltimoFoglio.Cells(riga(i), Colonna)
Colonna = Colonna + Uc - Fc + 1
Next
Next
Range("a5000").CurrentRegion.ClearContents
[A1].Select
End Sub


Function fnFineCol(riga As Variant) As Long
Dim Colonna As Long
Dim Indice As Integer
For Indice = 2 To 5
Set shUltimoFoglio = Worksheets("Foglio" & Indice)
For Colonna = 1 To 250
If shUltimoFoglio.Cells(riga, Colonna) = "" Then
fnFineCol = Colonna
Exit Function
End If
Next Colonna
Next Indice
End Function
che è molto più complessa che consente di copiare i range selex nelle righe dettate dai volori indicati nelle celle del range A1:E1 in modo che le celle siano copiate in coda alla riga e in modo che nel momento che la riga nel foglio sia terminata il programma copii il range direttamente nel foglio successivo.
quindi per me le due macro sono funzionali e complementali l'una all'altra.
Praticamente io:selex un range di 5 celle consecutive e faccio partire la macro copiacelle che copia le celle nell'intervallo A1:E1 in seguito selex 3 gruppi separati da 5 celle consecutive e faccio partire la macro copiarange le celle vengono così copiate dove voglio io.
il lavoro da quando utilizzo le due macro viaggia abbastanza spedito però il selezionare manualmente le celle fa perdere un pò di tempo senza contare gli eventuali errori mi chiedevo se fosse possibile creare una nuova maxi macro che unisse le due macro e consentisse di nn selex manualmente le celle .
Mi spiego: PREMESSO che
- le celle selex sono sempre 4 gruppi da 5 celle consecutive (es R3,S3,T3,U3,V3)
- le celle da selex si trovano TUTTE sulla stessa riga
- tra un gruppo di celle da selex e l'altro c'è sempre un intervallo di 3 celle da nn tener presenti cioè da nn selex per il lavoro che mi interessa .
quindi ad esmpio se la prima cella da selex è R3..il range R3:V3 viene utilizzato per la macro copiacelle...i range Z3:AD3, AH3:AL3, AP3:AT3 vengono selex per la macro copia range ...tra tutti e 4 i range selex ci sono sempre degli intervalli di 3 celle che nn vengono prese in considerazione
Mi chiedo se è possibile creare una macro che facesse questo:selezionando solo la prima cella es R3 dicesse al programma di copiare le celle R3:V3 secondo quanto indicato dalla macro copiacelle e gli altri 3 range secondo i criteri della macro copiarange sempre considerando i criteri di selezione sopra descritti.
Ovviamente la macro deve essere valida per qualsiasi cella del foflio e nn solo per R3 e susseguenti.....
Mirendo conto che sono stato un pò prolisso ma è un problema complesso e volevo essere il più chiaro possibile......spero che ci sia una soluzione ai miei problemi ....ma sò già che se c'è voi la troverete.... GRAZIE

salve
ti posto la soluzione che ti ho messo anche nella richiesta di altro forum.
la macro
Sub CopiaCelle()
non serve, sostituisci la tua macro CopiaRange() come segue:

Public shUltimoFoglio As Worksheet
Sub CopiaRange()
Dim riga() As Variant
Dim Colonna As Long
Dim shF1 As Worksheet
Dim RNG As Range
Set shF1 = Worksheets("Foglio1")
shF1.Select
On Error GoTo FINE
Set RNG = Application.InputBox(prompt:="seleziona/dimmi cella", Type:=8)
RNG.Resize(1, 5).Select
Application.ScreenUpdating = False
Selection.Copy Destination:=Sheets("foglio2").Range("a5000")
col = Selection.Column
rr = Selection.Row
celcount = Selection.Count
ReDim riga(celcount)
For ic = 0 To celcount
riga(ic) = Cells(rr, col).Value
col = col + 1
Next
Sheets("foglio2").Select
Range("a5000").CurrentRegion.Select
For i = LBound(riga) To UBound(riga) - 1
Colonna = fnFineCol(riga(i))
Fr = Selection.Row
Fc = Selection.Column
Ur = Selection(Selection.Count).Row
Uc = Selection(Selection.Count).Column
For nr = Fr To Ur
Range(Cells(nr, Fc), Cells(nr, Uc)).Copy Destination:=shUltimoFoglio.Cells(riga(i), Colonna)
Colonna = Colonna + Uc - Fc + 1
Next
Next
Range("a5000").CurrentRegion.ClearContents
[A1].Select
FINE:
End Sub

saluti

---