operazione più righe: problema macro

[andreia]

Ciao a tutti,
sono nuovo nel forum ed ho pochissima esperienza di programmazione. Ho il seguente problema: su un foglio di lavoro ho i dati di input (388 righe), su un altro ho impostato una matrice che mi consente di ricalcolare i dati di partenza. IN questa matrice vanno messi i valori di input presenti nel primo foglio, riga per riga. Per evitare il copia e incolla vorrei impostare una macro che possa eseguire automaticamente l'operazione (essenzialmente copia e incolla e poi copia e incolla il risultato in un altro foglio). Sono riuscito molto banalmente a registrare i passaggi ma non riesco a metterlo in loop (nel modo seguente le operazioni coinvolgono solo la prima riga, chiaramente, vorrei poterlo fare per tutta la matrice di input). Di seguito il codice, sapreste aiutarmi? Grazie


Sub Macro3()
'
' Macro3 Macro
'

'
Sheets("DATI").Select
Range("AP5:AR5").Select
Selection.Copy
Sheets("tab_ripartizione CC CK").Select
Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("DATI").Select
Range("AT5:AU5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("tab_ripartizione CC CK").Select
Range("F5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("DATI").Select
Range("AO5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("tab_ripartizione CC CK").Select
Range("I5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("DATI").Select
Range("AW5:AX5").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("tab_ripartizione CC CK").Select
Range("J5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B11:L11").Select
Application.CutCopyMode = False
Selection.Copy
Range("B26").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("DATI").Select
Range("AP6:AR6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("tab_ripartizione CC CK").Select
Range("B5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("DATI").Select
Range("AT6:AU6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("tab_ripartizione CC CK").Select
Range("F5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("DATI").Select
Range("AO6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("tab_ripartizione CC CK").Select
Range("I5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("DATI").Select
Range("AW6:AX6").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("tab_ripartizione CC CK").Select
Range("J5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("B11:L11").Select
Application.CutCopyMode = False
Selection.Copy
Range("B27").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False

End Sub

[Marius44]

Ciao
Il registratore di macro di mostra un codice ridondante.
Per la prima parte della tua macro ti suggerisco di fare così

Codice: Seleziona tutto

Sub Macro3()
Dim sh1 As Worksheet
Dim sh2 As Worksheet

Set sh1 = Sheets("DATI")
Set sh2 = Sheets("tab_ripartizione CC CK")

'ultima riga della col.B del Foglio "DATI"
ultimariga = sh1.Cells(Rows.Count, 2).End(xlUp).Row
'ciclo
For i = 5 To ultimariga
  sh1.Range("AP" & i & ":AR" & i).Copy
  sh2.Range("B" & i).PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  sh1.Range("AT" & i & ":AU" & i).Copy
  sh2.Range("F" & i).Selection.PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  sh1.Range("AO" & i).Copy
  sh2.Range("I" & i).PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  sh1.Range("AW" & i & ":AX" & i).Copy
  sh2.Range("J" & i).PasteSpecial Paste:=xlPasteValues, _
    Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  Application.CutCopyMode = False
Next i

Set sh1 = Nothing
Set sh2 = Nothing

End Sub


Ovviamente per le altre righe, cioè come queste Range("B11:L11"), Range("B26"), Range("AP6:AR6"), ed altre simili non puoi utilizzare il ciclo come sopra ma devi crearne un altro.

Spero sia comprensibile e, principalmente, ti sia utile.
Cioa,
Mario