Macro per copiare una riga nella prima riga libera di una tabella

Question

Ciao a Tutti,

innanzitutto Auguri di Buon Anno!

Ho bisogno di un aiuto.. nel file allegato ho già creato le macro che mi permettono di copiare i dati dal foglio 'copia dati' ai fogli 'NLC' o 'BVS'.

Queste due macro devono essere implementate che i dati vengano copiati nella prima riga disponibile della tabella (o storico, chiamatelo come volete) e non sempre sulla stessa riga, per entrambe le macro.

Mi aiutate per favore?

https://drive.google.com/file/d/14uiyrWyIFKhXOlocJPURP6hZgvsPKjoL/view?usp=sharing

Grazie

Alex

Answer 1

Ciao Alex,

mi da "VARIABILE NON DEFINITA"...

Set Rng = Selection...

 Nella macro Tester, sostituisci

    Dim srcRng As Range, destRng As Range

con:

    Dim srcRng As Range, destRng As Range

    Dim Rng As Range, rCell As Range

===

Regards,

Norman

Answer 2

mi da "VARIABILE NON DEFINITA"...

Set Rng = Selection...

Grazie

Answer 3

Ciao Alex,

Grazie dell'aiuto ma non sono molto pratico con Visual Basic..

come modifico le mie macro? Sostituisco in toto con quanto mi hai scritto?

Sì! Assegna le macro Copia_Dati_NLC e Copia_Dati_BVS ai due pulsanti sul foglio Copia dati.

Dove c'è modifica cosa devo modificare?

Purchè la riga da copiare sia la riga 2 e che i due fogli di interesse siano denominati 

NLC e BVS + F3D, non è necessario modificare nulla.

===

Regards,

Norman

Answer 4

Grazie dell'aiuto ma non sono molto pratico con Visual Basic..

come modifico le mie macro? Sostituisco in toto con quanto mi hai scritto?

Dove c'è modifica cosa devo modificare?

Scusa l'ignoranza... ;)

Grazie, Alex

Answer 5

Ciao Alex,

Ho bisogno di un aiuto.. nel file allegato ho già creato le macro che mi permettono di copiare i dati dal foglio 'copia dati' ai fogli 'NLC' o 'BVS'.

Queste due macro devono essere implementate che i dati vengano copiati nella prima riga disponibile della tabella (o storico, chiamatelo come volete) e non sempre sulla stessa riga, per entrambe le macro.

Mi aiutate per favore?

https://drive.google.com/file/d/14uiyrWyIFKhXOlocJPURP6hZgvsPKjoL/view?usp=sharing

Prova qualcosa del genere:

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

Option Explicit

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

Public Sub Copia_Dati_NLC()

    Const sFoglio As String = "NLC"                   '<<=== Modifica

    Call Tester(sFoglio)

End Sub

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

Public Sub Copia_Dati_BVS()

    Const sFoglio As String = "BVS + F3D"       '<<=== Modifica

    Call Tester(sFoglio)

End Sub

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

Public Sub Tester(sStr As String)

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim srcRng As Range, destRng As Range

    Dim arrIn As Variant

    Dim LRow As Long

    Const iRiga_Da_Copiare As Long = 2           '<<=== Modifica

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sStr)

    With SH

        Set Rng = Selection

        Set rCell = ActiveCell

        Set srcRng = SH.Rows(iRiga_Da_Copiare)

        arrIn = srcRng.Value

        LRow = LastRow(SH)

        Set destRng = .Rows(LRow + 1)  ', 1)

    End With

    destRng.Value = arrIn

End Sub

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

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range, _

                        Optional minRow As Long = 1, _

                        Optional sPassword As String)

    Dim bProtected As Boolean

    With SH

        If Rng Is Nothing Then

            Set Rng = .Cells

        End If

        bProtected = .ProtectContents = True

        If bProtected Then

            .Unprotect Password:=sPassword

        End If

    End With

    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

    If LastRow < minRow Then

        LastRow = minRow

    End If

    If bProtected Then

        SH.Protect Password:=sPassword, _

                   UserInterfaceOnly:=True

    End If

End Function

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

===

Regards,

Norman