Aiuto per copiare e duplicare intervallo di righe più volte

Salve A tutti,mi chiamo Fabrizio, Volevo chiedere un aiuto per quello che riguarda il duplicare un intervallo di righe x volte tramite imputbox.
Per farmi capire ho allegato il file d'interesse.

Nel foglio "sal" è presente un pulsante con codice "doppia macro" nominato "inserisci nuova voce"
E premendo una volta il pulsante,il codice che ho creato va a copiare un intervallo di righe, ovvero dalla riga 1766 alla 1776 .
Rischiacciando lo incollo dove mi posiziono con il cursore a sinistra.
Però a questo punto mi sono bloccato , e vorrei inserire tramite imputbox anche quante volte incollare l'intervallo di righe, Es: 1, oppure 10 volte.
Qualcuno puo' aiutarmi ???
Grazie

https://www.freeforumzone.com/mobile/d/11672326/Listbox-ricerca-con-testo/discussione.aspx
Solo per dirTi che nel post 29/12/2019 12.56, ho scritto ...Set sh1 = ActiveWorkbook.Worksheets("Elenco Prezzi2") per evitare l'errore in apertura.
Adesso rimodifico il pensiero, basta modificare in Workbook_Open
Sub Workbook_Open()
Sheets("Elenco Prezzi2").Activate
End Sub
Poi mettere in SetFg()
Set sh1 = Worksheets("Elenco Prezzi2") ecc ecc
Vedo diversi altri errori (tipo la convalida dati in B15 con tanti spazi), inoltre il fatto che NON dichiari mai le variabili

Riguardo la domanda (il bottone, a me in errore)
Sub DoppiaMacro3()
Dim tot As Long 'variabile
If Controllo = False Then
' EX (copy) e poi in cella selezionata incolla per aggiungere 10 righe
Controllo = True
Else
tot = InputBox("quante righe aggiungere", 0) ' ho valorizzato la variabile
' EX (copy) e poi in cella selezionata incolla per tot righe
Controllo = False
End If
End Sub

Ciao, grazie come sempre per la disponibilità!
Il file in questione non è quello definitivo, quello è un file meno articolato che ho usato per fare le prove!
I tuoi graditi consigli sono andati nel file definitivo! Grazie mille

Ho controllato e avevo lasciato il pulsante con il link del vecchio foglio .
Ora ho riallegato il file.

Il codice che hai scritto dove lo dovrei inserire?
grazie

Option Explicit
Private Controllo As Boolean
Sub DoppiaMacro3()

If Controllo = False Then
Call Macro101
Controllo = True
Else
Call Macro104
Controllo = False
End If

End Sub

----------------------------------------------------------------------
Sub Macro101()
'
' Macro101 Macro
'
Application.ScreenUpdating = False
Cells.Find( _
what:="*", _
after:=Range("a1"), _
searchOrder:=xlByRows, _
searchdirection:=xlPrevious).Select
ActiveCell.Offset(-8, 0).Rows("1:9").EntireRow.Select
ActiveCell.Activate
Selection.Copy
Selection.EntireRow.Hidden = False
Application.ScreenUpdating = True
MsgBox "posizionati nella cella dove vuoi inserire la nuova voce, POI rispingi il bottone"
End Sub

---------------------------------------------------------------------
Sub Macro104()
'
' Macro104 Macro
'

'
Dim MYMESSAGE As Variant
MYMESSAGE = MsgBox("VUOI PROCEDERE A INSERIRE NUOVA VOCE VUOTA?", vbOKCancel)
If MYMESSAGE = vbOK Then
Application.ScreenUpdating = False
Selection.Insert Shift:=xlDown

ActiveWindow.SmallScroll Down:=6
ActiveCell.Offset(8, 24).Range("A1:B1").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=ActiveCell.Range("A1:B2"), Type:= _
xlFillDefault
ActiveCell.Range("A1:B2").Select

ActiveCell.Offset(0, 19).Range("A1").Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A2"), Type:= _
xlFillDefault
ActiveCell.Range("A1:A2").Select

ActiveCell.Offset(1, -43).Range("A1").Select
ActiveWindow.SmallScroll Down:=3

Cells.Find( _
what:="*", _
after:=Range("a1"), _
searchOrder:=xlByRows, _
searchdirection:=xlPrevious).Select
ActiveCell.Offset(-8, 0).Rows("1:9").EntireRow.Select
ActiveCell.Activate
Selection.Copy
Selection.EntireRow.Hidden = True

Application.ScreenUpdating = True
ElseIf MYMESSAGE = vbCancel Then
MsgBox "CANCELLATO"
End If
End Sub

Ripensavo, che la "sub 104" non solo incolla ma nella registrazione che ho fatto mi facesse anche delle modifiche mirate, quindi sicuramente sarebbe l'ideale una inputbox per dare la possibilita' di scgliere quante volte voler ripetere la macro 104.
spero di essermi spiegato?
grazie

Vedi che inserire una brutta-copia, non è facile per Noi aiutare se poi all'interno ci sono centinaia di macro. Comunque tutte le macro vanno riviste.
Mi sembra che desideri copiare una decina di righe da qualche parte e Tu deciderai "Dove" selezionando solamente una cella? Per me è una brutta soluzione dove puoi creare diversi errori da parte dell'utente.
1) Non hai detto quale area da copiare e dove...
2) Premesso che in riga 1631:1652 ci sono delle righe "di riepilogo"
3) Che nascondi le righe
Per quanto abbia capito, tramite VBA renderei visibili tutte le righe, troverei in quale riga è posizionato "TOTALI COMPUTO"= riga 1631... penso che l'area sia 1623-1630 (me sembrano solo 8 righe), inserisco 8 righe in 1631 ed incollo, rinascondo le righe
Prova questo codice
Sub Inserisci()
Dim x As Long, tot As Variant, y As Long
tot = InputBox("quante volte copiare la selezione. EX 1,2,3 ecc ecc", "Inserimento", 0)
If tot = 0 Or tot = "" Then: MsgBox "Esco dalla procedura": Exit Sub
Application.ScreenUpdating = False
y = Application.WorksheetFunction.Match("TOTALI COMPUTO", Range("C:C"), 0)
'y adesso è valorizzato a 1631
Rows("33:" & y).EntireRow.Hidden = False
For x = 1 To tot
Rows(y & ":" & y + 7).Insert Shift:=xlDown ' 7 righe
Range(Cells(y, 1), Cells(y + 7, 19)).Clear ' 7 righe
Range(Cells(y - 8, 1), Cells(y - 1, 19)).Copy 'NB (copiato A1623:T1630) = ultime 8 righe
Cells(y, 1).PasteSpecial
y = y + 8
Next x
Rows("33:" & y - 1).EntireRow.Hidden = True
Application.ScreenUpdating = True
End Sub

Ciao allora in pratica funziona così la macro,;schiacco il pulsante 1 volta e lui mi copia le righe nascoste del foglio sal, poi do ok al msbox, poi mi posiziono con il mouse tra le voci in una riga vuota, es tra la 1 e la 2 sempre del foglio sal, e schiacco una seconda volta il pulsante e mi incolla la voce pulita, però mi va ad applicare anche delle formule in righe nascoste!
In pratica avrei bisognodi aggiungere una inputbox per definire quante volte voglio ripetere la sub 104!

ho prvato il codice che mi hai allegato sopra, e come ti spiegavo manca tutto un pezzo , perchè io le righe le devo poter inserire negli intermezzi di altre voci, e non in fondo come ultime voci.Inoltre nel mio codice è presente tutto una parte per collegare singolarmente le Voci incollate.
E quindi servirebbe ,una inputbox come quella che mi hai presentato nel tuo codice che è perfetta , che pero' mi ripeta la "sub 104", così facendo si incolleranno le voci con i collegamenti attivi negli intermezzi delle voci..
GRAZIE ....

Ciao Fabrizio, ho aperto il file e sembra che crei un nuovo blocco.

le righe che dici di voler aggiungere dove vanno?.

Ho preso il tuo file le righe sono libere fino alla 41, ho fatto la prova ad inserire un nuovo blocco proprio alla 41 mi sono posizionato in A41 ed ho premuto il pulsante ed in effetti adesso vedo il nuovo blocco da 41 a 50 ma l'ha inserito ex novo oppure ha scoperto le righe?.

ora le righe da aggiungere dove sono a quale riga?

Ciao By Sal

>>>che pero' mi ripeta la "sub 104"
Credo non possa funzionare, perchè nel Tuo codice (strambo) serve una cella già selezionata che al secondo passaggio non esisterebbe

Non capisco cosa intendi per...
>>>si incolleranno le voci con i collegamenti attivi negli intermezzi delle voci..

>>>ActiveCell.Offset(-8, 0).Rows("1:9").EntireRow.Select
Ammettiamo che hai selezionato la cella A15 in teoria l'area da copiare sarebbe A7:I15 ??? Mà dove va copiata ???

Ps. Non riesco capire il Tuo VBA, forse qualche altro utente riesce meglio di me

Ciao Bysal,GRAZIE.
esatto il blocco è nascosto dalla 1776 alla 1784.
In sostanza Come gia' spiegato, vorrei tramite inputbox ripetere "x volte" solo la "sub 104" , per intenderci nel momento che schiaccio per la seconda volta lui chiedesse "quante voci vuoi inserire?."
questa è formula per intero :


Option Explicit
Private Controllo As Boolean
Sub DoppiaMacro3()

If Controllo = False Then
Call Macro101
Controllo = True
Else
Call Macro104
Controllo = False
End If

End Sub

----------------------------------------------------------------------
Sub Macro101()
'
' Macro101 Macro
'
Application.ScreenUpdating = False
Cells.Find( _
what:="*", _
after:=Range("a1"), _
searchOrder:=xlByRows, _
searchdirection:=xlPrevious).Select
ActiveCell.Offset(-8, 0).Rows("1:9").EntireRow.Select
ActiveCell.Activate
Selection.Copy
Selection.EntireRow.Hidden = False
Application.ScreenUpdating = True
MsgBox "posizionati nella cella dove vuoi inserire la nuova voce, POI rispingi il bottone"
End Sub

---------------------------------------------------------------------
Sub Macro104()
'
' Macro104 Macro
'

'
Dim MYMESSAGE As Variant
MYMESSAGE = MsgBox("VUOI PROCEDERE A INSERIRE NUOVA VOCE VUOTA?", vbOKCancel)
If MYMESSAGE = vbOK Then
Application.ScreenUpdating = False
Selection.Insert Shift:=xlDown

ActiveWindow.SmallScroll Down:=6
ActiveCell.Offset(8, 24).Range("A1:B1").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=ActiveCell.Range("A1:B2"), Type:= _
xlFillDefault
ActiveCell.Range("A1:B2").Select

ActiveCell.Offset(0, 19).Range("A1").Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A2"), Type:= _
xlFillDefault
ActiveCell.Range("A1:A2").Select

ActiveCell.Offset(1, -43).Range("A1").Select
ActiveWindow.SmallScroll Down:=3

Cells.Find( _
what:="*", _
after:=Range("a1"), _
searchOrder:=xlByRows, _
searchdirection:=xlPrevious).Select
ActiveCell.Offset(-8, 0).Rows("1:9").EntireRow.Select
ActiveCell.Activate
Selection.Copy
Selection.EntireRow.Hidden = True

Application.ScreenUpdating = True
ElseIf MYMESSAGE = vbCancel Then
MsgBox "CANCELLATO"
End If
End Sub

Si , ragione il codice l'ho dovuto parzialmente registrare.
Quando pigi' la prima volta il pulsante ,il blocco di righe viene copiato.
Poi ti posizioni e rischiacci il bottone, prima viene incollatoil blocco di righe e poi fa le modifiche.

Ciao il blocco righe dove viene copiato?, cioè se io scelgo di inserire 3 righe queste 3 righe dove vanno aggiunte?

parliamo per riferimento foglio "Sal" al blocco 1 dalla riga 6 alla riga 13 dove mi posiziono per inserire le righe? facciamo che vorrei inserire 2 righe, indicami dove ti posizioni per inserire le 2 righe, quale riga e quale colonna.

un ultima cosa, quando usi Workbook_open(), non puoi far riferimento a "sub Setfg()" per posizionarti sui fogli a volte non viene letto e quindi va in errore, in questo caso quando usi Workbook_Open fai riferimento direttamente al foglio tipo


o il nome del foglio che vuoi posizionarti all'apertura.

Ciao By Sal

Allora nella colonna "A" è presente l'intestazione "N." e si trovano delle voci di capitolato numerate colorate in rosa, poi ci sono 2 righe azzurre a chudere la voce di capitolato.
Ora 3 righe vuote bianche, e poi in successione le altre voci e sempre in alternanza le 3 o 4 o 5 ... righe bianche vuote.
in pratica al primo clik del pulsante lui mi copia l'"intero blocco di righe" nascoste ,e poi mi posiziono a mia scelta , per esempio se e ho bisogno ad esempio di aggiungere diverse voci tra la voce 1 e la voce 2, io mi posiziono nelle righe bianche vuote(questo a mia scelta).
Do il secondo clik e mi incolla l'intero blocco di righe.
Poi mi sitema i vari collegamenti di formule nelle varie celle nascoste orrizzontalmente.

Da far notare che il foglio "sal" , alla esigenza dovro' copiarlo e rinominarlo in base al numero di "SAL" che dovro' fare.
Per esempio gennaio "sal 1", poi in febbraio dovro' fare il "SAL 2" e cosi' via in base alla durata dei cantieri...

Ciao fabrizio, tu ho lasciato una mail, perche non ho capito molto, cosa che per te sarà lampante.

Ciao By Sal

Ciao GRAZIE ho ricevuto la tua mail ma purtroppo sono tornato al lavoro, sono finite le ferie Natalizie! PECCATO!
E non ho Skype.
Ieri sera dando una occhiata in giro ho trovato questo post, e te lo giro tradotto in italiano, forse con questo puoi capire quello che mi può aiutare!
Almeno credo :
--------
Come fare l'esecuzione di una macro x volte dove x è il valore di A1?


crea la formula della macro in un ciclo do while e imposta il contatore sul valore dell'intervallo ("A1")
Sub Macro2()

Dim i as Long
For i=1 to Range("A1").Value
Macro1
Next i

End Sub


----
Ipotizzato che il nome macro2 rimanga uguale, Al posto della macro 1, cambio con macro 104. E al posto di Range a1 cambio con la inputbox così da avere la possibilità di ripetere x volte la macro 104.
Così facendo il codice mio potrebbe ad esempio diventare :
Option Explicit
Private Controllo As Boolean
Sub DoppiaMacro3()

If Controllo = False Then
Call Macro101
Controllo = True
Else
Call Macro2
Controllo = False
End If

End Sub

Cosi le mie macro 104 e 101 rimangono così come sono.

Ciao Bene a questo punto credo che tu abbia risolto.

Un saluto Ciao By Sal

Ciao bysal ho provato ad applicare quello che ho postato,e per essere funziona,purtroppo ho notato che un volta posizionato alla secondo clik, invece di incollare il blocco mi inserisce solo 1 cella nella quale mi sono posizionato con il mouse.
E se gli dico di copiare 5 volte,
in pratica non avendo piu' modo di posizionarmi con il mouse, ripete si la macro 104 ma non succede nulla.
Tu hai qualche soluzione a questo enigma???

Option Explicit
Private Controllo As Boolean
Sub DoppiaMacro3()

If Controllo = False Then
Call Macro101
Controllo = True
Else
Call Macro1104
Controllo = False
End If

End Sub

-------------------------------------
Sub Macro1104()
'
' Macro1104 Macro
Dim i As Long
For i = 1 To Application.InputBox("quante voci vuoi inserire?", , , , , , 1)
Macro104
Next i
End Sub


-------------------
Sub Macro104()
'
' Macro104 Macro
'

'
Dim MYMESSAGE As Variant
MYMESSAGE = MsgBox("VUOI PROCEDERE A INSERIRE NUOVA VOCE VUOTA?", vbOKCancel)
If MYMESSAGE = vbOK Then
Application.ScreenUpdating = False
Selection.Insert Shift:=xlDown

ActiveWindow.SmallScroll Down:=6
ActiveCell.Offset(8, 24).Range("A1:B1").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=ActiveCell.Range("A1:B2"), Type:= _
xlFillDefault
ActiveCell.Range("A1:B2").Select

ActiveCell.Offset(0, 19).Range("A1").Select
Selection.AutoFill Destination:=ActiveCell.Range("A1:A2"), Type:= _
xlFillDefault
ActiveCell.Range("A1:A2").Select

ActiveCell.Offset(1, -43).Range("A1").Select
ActiveWindow.SmallScroll Down:=3

Cells.Find( _
What:="*", _
After:=Range("a1"), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Select
ActiveCell.Offset(-8, 0).Rows("1:9").EntireRow.Select
ActiveCell.Activate
Selection.Copy
Selection.EntireRow.Hidden = True

Application.ScreenUpdating = True
ElseIf MYMESSAGE = vbCancel Then
MsgBox "CANCELLATO"
End If
End Sub

---------------------------------

Ciao non far partire le 2 macro insieme lancia prima la prima e poi la seconda.

cioè devi lanciarle singolarmente una alla volta.

Ciao By Sal

Ciao grazie!
Ma non mi è chiaro...
Come si fa realizzativamente nel codice?

Guarda cosa fa e a cosa l'istruzione Call.

>>>Credo non possa funzionare, perchè nel Tuo codice (strambo) serve una cella già selezionata che al secondo passaggio non esisterebbe

Ps. Se mi permetti, nel Tuo allegato ci sono "quasi 50 moduli" di cui 10/15 vuoti. Personalmente metterei in un modulo rinominandolo (Ex Inserisci) le 3/4 macro relative, cioè DoppiaMacro3, 101 e 104 e Macro2.
In altri moduli eventuali macro che fanno altri lavori distinti ecc ecc
Eliminare i moduli vuoti ed eventualmente raggruppare in 2/3 moduli ex Varie1, Varie2 tutte le mini-macro singolari
In modo tale che sia più facile rintracciarle quando ci si deve mettere le mani

>>>dalla riga 1766 alla 1776
>>>dalla 1776 alla 1784
Ps. Sono confuso, puoi riallegare specificando bene le righe e dirmi se devono essere aggiunte oppure sovrascritte

Allego un files di prova nel quale ho cancellato riga5-1648 "NON Eliminato"
Vedi foglio Sal3, prova sugli altri (macro inserisci)
NB. Area A1776:AR1784, vedi di ripulire gli errori ex V1782 e AK1778:AN1780

Ciao grazie!
ho potuto fare solo una prova veloce,(e sicuramente guarderò con più meglio ) se per esempio nel foglio sal 1 o sal 2 ecc... la voce 1 per esempio diviene "muro" e la voce 2 "porta", e volessi inserire una voce tra le due, avviando il pulsante "inserisci" il blocco non viene incollato tra le 2 voci... Ti risulta?
Accolgo e sistemerò meglio i moduli!
Però nel mio foglio diciamo completo tutte le righe con le formule sono collegate e anche tutte le macro! Sarà da fare sicuramente un po di ordine!
GRAZIE MILLE

Se si tratta d'inserire mi basterebbe modificare una riga, però dovrei pure mettere un "trovami" l'area da copiare. A me non piace per nulla comunque usando lo stesso codice Tuo a condizione che Ti posizioni sopra la cella che contiene 1,2,3,4 ecc ecc
Da provare con le altre due macro che usi già

Ciao ho provato il codice che mi hai postato e notavo che fa la stessa cosa di prima, non so se sglio qualcosa.
Pero' posizionandomi sul numero della voce non mi inserisce le voci negli intermezzi.
grazie per l'aiuto.!!!


Ma giusto una curiosita.
"Ciao non far partire le 2 macro insieme lancia prima la prima e poi la seconda.

cioè devi lanciarle singolarmente una alla volta."
Io ho provato a dare un'occhiata a "Call" come suggeriva alfrimpa, ma purtroppo non ho ancora molte conoscenze del vba e non è che ho capito un gran che.
Si potrebbe avere un esempio sul codice che ho postato ???
Se possibile...
GRAZie

L'istruzione Call non fa altro che eseguire una macro all'interno di un'altra macro; se scrivo



verrà eseguire la macro1

Non c'è molto altro da capire.

Fabrizio, sei un grande confuzionario...con tante idee strambe & formule errate

Premesso che non ci fornisci spiegazioni idonee.
Non accetti, oppure respingi nuovi VBA (alludendo ad errori vari). Ho usato il TUO files + il TUO codice ed inserito solamente alcune righe per fargTi fare un "multi-inserimento" e adesso non và bene ancora...?

OK non Ti disturbo più... Nell'ultimo Tuo files allegato
Se notate l'area "A1776:BN1784" è diversa dall'area "A5:BN13"

Pertanto quello che vediamo è errato (poi sapere cosa gli servano tutte quelle righe nascoste mi rimane un mistero).
Per me il VBA è fatto, se poi non va bene OK
Saluti

Ciao ,guarda ti chiedo scusa, ma il tuo codice è sicuramente valido e funziona, ma come ti ho scritto probabilmente sbaglio qualcosa io...
E chiedendo di Call, non era mia intenzione sminuire il tuo lavoro..
Magari faro' piu' attenzione.
Scusami.