![Imbarazzato :oops:](./images/smilies/icon_redface.gif)
![eeh? :eeh:](./images/smilies/icon_eek.gif)
Moderatori: Anthony47, Flash30005
alanford ha scritto:ho un xls molto grosso composto dai campi: codice;qta;prezzo. nella magg parte il campo qta contiene 1 in altri casi valori diversi. Problema: ad ogni valore diverso (es 5) dovrei replicare la riga (per 5 volte) E' possibile farlo in automatico ?![]()
Sub Replica_N()
Dim Cur_QT As Integer
Col_Qt = "B1"
Riga_HD = Right(Col_Qt, 1)
Dest_WS = "USCITA"
Sorg_WS = Range("A1").Worksheet.Name
If Sorg_WS = Dest_WS Then Exit Sub
Riga_ULT = Range(Left(Col_Qt, 1) & "65536").End(xlUp).Row 'calcola l' ultima riga utile
'Azzera il foglio di Output:
Sheets(Dest_WS).Select
Cells.Select
Selection.Clear
Range("A1").Select
'Copia Header su Uscita
Worksheets(Sorg_WS).Activate
Range(Col_Qt).Select
ActiveCell.Offset(0, -1).Range("A1:C1").Copy
Sheets(Dest_WS).Select
Range("A1").Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
'Copia le righe di dati validi
On Error Resume Next
For riga = 1 To (Riga_ULT - Riga_HD)
Sheets(Sorg_WS).Select
ActiveCell.Offset(riga, -1).Range("A1:C1").Copy
Sheets(Dest_WS).Select
ActiveSheet.Paste
ActiveCell.Offset(1, 0).Select
Cur_QT = Int(ActiveCell.Offset(-1, 1).Value)
'Se Qt > 1, crea tante righe con Qt=1
If Cur_QT > 1 Then
For Rip = 2 To Cur_QT
ActiveCell.Offset(-1, 1) = 1
ActiveSheet.Paste
ActiveCell.Offset(0, 1) = 1
ActiveCell.Offset(1, 0).Select
Next Rip
End If
Salta:
Cur_QT = 0
Next riga
Application.CutCopyMode = False
End Sub
Dest_WS = "USCITA": Dest_WS = "foglio2" ' non avevi dichiarato la destinazione
Application.ScreenUpdating = False' eviti lo sfarfallio tra i fogli
Sorg_WS = Range("A1").Worksheet.Name
If Sorg_WS = Dest_WS Then Exit Sub
'Riga_ULT = Range(Left(Col_Qt, 1) & "65536").End(xlUp).Row 'calcola l' ultima riga utile
Riga_ULT = Sheets(1).[A2].End(xlDown).Row 'calcolo l'ultima riga scritta
'Azzera il foglio di Output:
Torna a Applicazioni Office Windows
Macro che scatta quando cambia dato in un altro file Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 14 |
Inserire 2 valori nella stessa cella Autore: Ricky0185 |
Forum: Applicazioni Office Windows Risposte: 2 |
Excel: formula automatica per evidenziare prodotto scaduto Autore: gamma_ray |
Forum: Applicazioni Office Windows Risposte: 3 |
Salvare file excel in formato html escludendo le immagini Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 10 |
Problema con macro copia e rinomina file Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 2 |
Visitano il forum: Nessuno e 63 ospiti