Creazione di macro copia celle in riga da un foglio in un altro foglio non eliminando le righe sovrastanti

Question

Domanda banale:

Devo copiare delle caselle da b7 a b17 presenti del foglio1

nel foglio2 in cui sono presenti dei dati nelle righe precedenti, e trovare ogni volta la riga vuota dove copiare.

Grazie

Answer 1

Ciao Fabio,

Domanda banale:

Devo copiare delle caselle da b7 a b17 presenti del foglio1

nel foglio2 in cui sono presenti dei dati nelle righe precedenti, e trovare ogni volta la riga vuota dove copiare.

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

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

Option Explicit

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

Public Sub Tester()

    Dim WB As Workbook

    Dim srcSH As Worksheet, destSH As Worksheet

    Dim srcRng As Range, destRng As Range

    Dim LRow As Long

    Const sFoglioSorgente As String = "Foglio1"            '<<=== Modifica

    Const sFoglioDest As String = "Foglio2"                     '<<=== Modifica

    Const sIntervallo As String = "B1:B17"                       '<<=== Modifica

    Set WB = ThisWorkbook

    With WB

        Set srcSH = WB.Sheets(sFoglioSorgente)

        Set destSH = WB.Sheets(sFoglioDest)

    End With

    Set srcRng = srcSH.Range(sIntervallo)

    With destSH

        LRow = LastRow(destSH, .Columns("A:A"))

        Set destRng = .Range("A" & LRow + 1)

    End With

    srcRng.Copy Destination:=destRng

End Sub

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

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range, _

                        Optional minRow As Long = 1)

    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

    If LastRow < minRow Then

        LastRow = minRow

    End If

End Function

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

• Alt+Q per chiudere l'editor di VBA e tornare a Excel
• Salva il file con l’estensione xlsm
• Alt+F8 per aprire  la finestra di gestione delle macro
• Seleziona Tester | Esegui

Potresti scaricare il mio file di prova Marco20170212.xlsm a:

https://www.dropbox.com/s/zdbficfy9suoiug/Marco20170212.xlsm?dl=0

===

Regards,

Norman