Comando Per Copiare e aggiungere Righe in foglio excel 2010

Question

Sto  cercando un sistema per ripetere una riga (piu' celle sulla stessa riga ) in un foglio di excel

cliente	data ric.richiesta	nr rif cliente			Mio riferimento	in corso	evaso
					Nr. Progressivo
					Pulsante Macro

Vorrei poter copiare questo modulo attivando il "Pulsante Macro" ,magari se possibile facendo generare in automatico il nr. Progressivo nella NUOVA Rispettiva cella 

Ogni volta che si clicca su Pulsante Macro si aggiunge questo modulo nella riga (magari saltandone una ) vuota successiva al modulo .......E'  Possibile ????  

Non sono un esperto di excel e sto' incominciando ora a curiosare in Visual Basic , mi sto' arrabattando , se qualcuno mi suggerisce una soluzione gliene sar' grato

Grazie  a  Tutti    Claudio

Answer 1

Ciao Claudio,

Oltre a ringraziarti di nouvo per quanto hai sino ad ora fatto , vorrei porti un'ulteriore domanda ...senza riaprire il Thread ....

Sarebbe possibile fare in modo che  le  Nuove  righe  aggiunte  restino   nella posizione di origine

cerco di spiegarmi meglio adesso quando clicco sul pulsante macro mi aggiunge le nuove righe numerate progressivamente nel seguente modo :

Righe generatrici      nr. progr   100

nuova riga                                101

"""""""""""                                  102   eccetera

Come si puo' fare per mantenere le righe generatrici (le Prime del Foglio ) ferme ma con l'ultimo nr. progressivo  generato (le altre dovrebbero scendere sotto )

Se ho captito la tua esigenza, prova di sostituire il codice precedentre con la seguente versione:

'=========>>

Option Explicit

'--------->>

Public Sub Tester()

    Dim SH As Worksheet

    Dim srcRng As Range, destRng As Range

    Dim LRow As Long

    Dim iNumero As Long

    Set SH = ActiveSheet

    With SH

        LRow = LastRow(SH, .Columns("A:H"))

        Set srcRng = .Range("F" & LRow)

        Set destRng = srcRng.Offset(1)

    End With

    With srcRng

        If IsNumeric(.Value) Then

            iNumero = .Value + 1

        End If

    End With

    destRng.Value = iNumero

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

                 Optional Rng As Range)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

End Function

'<<=========

Ho caricato il mio file di esempio Claudio20150319.xlsm a: **http://1drv.ms/1H3CMjt**

Devo   aprire un altro Thread ???

Visto che si tratta più o meno dello stesso argomento, non credo sia necessario aprire un nuovo thread ma ti ringrazio di averlo pensato.

===

Regards,

Norman

Answer 2

Ciao Claudio,

.....  Sorry

Scusa ma  non  si  salva .....

io  uso excel 2010 ....estensione  file  xlsx

il  visual basic che utilizzo e' la versione 2010

ho copiato il codice (inserisci modulo) ,poi salva file ....la macro non viene salvata ...!!!!!

Poiché tu stai utilizzando le macro, è necessario salvare il file con l'estensione xlsm invece dell'estensione xlsx.

===

Regards,

Norman

Answer 3

Ciao Claudio,

GRAZIE  GRAZIE GRAZIE

TNKS TNKS TNKS

Grandioso   Grazie !!!!!!!

Ti ringrazio per il cortese riscontro e per chiudere questo thread, ti chiedo di gentilmente segnare la mia risposta come Risposta.

....mi  vergogno un po'  ...ma  ci  provo .... 

ho  assemblato  (da  internet diversi codici che ...funzionano , lo scopo  e'  fare copia  di  un  singolo foglio di excel 2010 e salvarlo in una determinata cartella .

[Cut]

Sarò lieto di suggerire una soluzione. Tuttavia,  in quanto si tratta di una nuova richiesta, credo sia meglio aprire un nuovo thread. In questo modo tu assisterai altre persone che possono cercare gli archivi del forum per delle soluzioni a problemi simili e tu aumenterai la possibilità di ricevere risposte utili.

===

Regards,

Norman

Answer 4

Ciao Claudio,

• Alt-F11 per aprire l'editor di VBA
• Alt-IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

 '=========>>

Option Explicit

'--------->>

Public SubTester()

    Dim SH As Worksheet

    Dim srcRng As Range, destRng As Range, rCell As Range

    Dim arrIntestazioni As Variant

    Dim LRow As Long

    Dim iNumero As Long

    Const sIntestazioni As String = _

          "Cliente,Data Richiesta, nr Rif Cliente,,,Mio Riferimento,In Corso,Evaso"

    Set SH = ActiveSheet

    arrIntestazioni = Split(sIntestazioni, ",")

    With SH

        LRow = LastRow(SH, .Columns("A:H"))

       Set srcRng = .Range("F" & LRow)

       Set destRng = .Range("A" & LRow).Offset(2).Resize(1, 8)

    End With

    With destRng

        .Value = arrIntestazioni

        With srcRng

            If IsNumeric(.Value) Then

                iNumero = .Value + 1

            End If

        End With

        .Cells(1).Offset(1, 5).Value = iNumero

    End With

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

                 Optional Rng As Range)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

End Function

'<<=========

 Alt-Q per chiudere l'editor di VBA e tornare a Excel.

Sul foglio di interesse, inserisci un pulsante dagli strument Moduli e allega la macro Tester al pulsante.

Potresti scaricare il mio file di prova Claudio20150226 a:

                           http://1drv.ms/1EubtNa

===

Regards,

Norman

Answer 5

GRAZIE  GRAZIE GRAZIE

TNKS TNKS TNKS

Grandioso   Grazie !!!!!!!

....mi  vergogno un po'  ...ma  ci  provo ....

ho  assemblato  (da  internet diversi codici che ...funzionano , lo scopo  e'  fare copia  di  un  singolo foglio di excel 2010 e salvarlo in una determinata cartella .

Funziona benissimo  pero'  non mi da' la possibilita' di  dare un Nome Nuovo a questo file..non e' un dramma (rinomino manualmente appena fatto copia..) ..pero'  sembra  monco ...

?????  cosa  posso  aggiungere perche' il msgbox dell'applicazione filedialogpicker mi faccia inserire anche il nuovo nome file ?????

incollo qua' sotto il codice che ho rappezzato ..

COMUNQUE  GRAZIE  DI  CUORE  (non credevo che qualcuno mi avrebbe risposto....)

Claudio

Dim VBC As Object

Dim p As String

Sub CopiaFoglio()

    ' Seleziona la cartella destinazione in DDir

    With Application.FileDialog(msoFileDialogFolderPicker)

        .InitialFileName = DDir  '<<< Filtro per nome

        .Title = "Scegli la directory per il foglio " & ActiveSheet.Name

        .Show

        If .SelectedItems.Count = 0 Then    'directory non scelta

            MsgBox ("Scelta non effettuata, procedura abortita")

            Exit Sub

        End If

        DDir = .SelectedItems(1) & ""

    End With

    'Copia il foglio in un'altro al volo

    'Converte tutte le formule del foglio nel

    'valore al momento calcolato

    ActiveSheet.Copy

    Cells.Select

    Selection.Copy

    Cells.Select

    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False

    Application.CutCopyMode = False

    Range("A1").Select

    ' Salva il foglio

    NewFName = DDir & FPrefix & ActiveSheet.Name & ".xlsx"

    ActiveWorkbook.SaveAs Filename:=NewFName

    ActiveWorkbook.Close

    With ActiveWorkbook.VBProject

    For Each VBC In .VBComponents

    If VBC.Type = 100 Then

    With VBC.CodeModule

    .DeleteLines 1, .CountOfLines

    .CodePane.Window.Close

    End With

    End If

    Next VBC

    End With

End Sub