MACRO EXCEL per copiare dati da un foglio ad un altro

Question

Ciao a tutti!

Avrei bisogno di creare una macro Excel per copiare alcuni dati da un foglio excel ad un altro.

Dato che non sono molto pratico, qualcuno può aiutarmi?

Dal file di origine nome "Documenti03" vorrei riportare nel nuovo file nelle colonne A, B e C  il contenuoto delle contenuto delle colonne A, E e G se nella colonna H compare "Revisionare".

Al link il file di Documenti03

https://drive.google.com/open?id=1XTrI4E9Wy9Ee19JiFVl8P5G2TqYUabNT

Grazieeee

Answer 1

caspita!!! va da dio!

Però evidentemente non mi sono spegato molto bene all'inizio della mia richiesta di aiuto... :-/

Volevo fare esattamente quello che hai fatto però da un altro file excel vuoto/nuovo....

Quindi avendo Documenti03 e il file vuoto/nuovo nella stessa cartella, eseguendo la macro dal file vuoto/nuovo, vorrei riportare le colonne da "Documenti03" con lo stesso criterio adottato precedentemente....

...è possibile?

Perdonami e Non Odiarmi! 

Mirco

Answer 2

Ciao Mirco,

Grazie per la rapida risposta.

Ho eseguito le tue istruzioni e all'esecuzione ha dato:

"errore di compilazione sub o function non definita"

evidenzia riga 35 col 23:   LRow = LastRow(srcSH, Columns("A:A"))

Visto che ci sono ti chiedo se devo fare qualcosa sulle seguenti parti che risultano di carattere rosso:

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range, _

                        Optional minRow As Long = 1, _

                        Optional sPassword As String)

    Dim bProtected As Boolean

e  

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

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

Il codice citato sarebbe evidenziato in rosso se ci fossero righe vuote tra uno dei caratteri di sottolineatura (trattino basso) e la riga di codice successiva.

Per vedere il codice in azione, potresti scaricare il mio file di prova

Mirco20191001.xlsm

===

Regards,

Norman

Answer 3

Ciao Norman!

Grazie per la rapida risposta.

Ho eseguito le tue istruzioni e all'esecuzione ha dato:

"errore di compilazione sub o function non definita"

evidenzia riga 35 col 23:   LRow = LastRow(srcSH, Columns("A:A"))

Visto che ci sono ti chiedo se devo fare qualcosa sulle seguenti parti che risultano di carattere rosso:

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range, _

                        Optional minRow As Long = 1, _

                        Optional sPassword As String)

    Dim bProtected As Boolean

e  

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

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

Molte grazie per l'attenzione ed il supoprto!

Answer 4

Ciao Mircu,

Ciao a tutti!

Avrei bisogno di creare una macro Excel per copiare alcuni dati da un foglio excel ad un altro.

Dato che non sono molto pratico, qualcuno può aiutarmi?

Dal file di origine nome "Documenti03" vorrei riportare nel nuovo file nelle colonne A, B e C  il contenuoto delle contenuto delle colonne A, E e G se nella colonna H compare "Revisionare".

Al link il file di Documenti03

https://drive.google.com/open?id=1XTrI4E9Wy9Ee19JiFVl8P5G2TqYUabNT

Grazieeee

Prova qualcosa del genere:

• 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

Option Compare Text

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

Public Sub Tester()

    Dim srcWB As Workbook, destWB As Workbook

    Dim srcSH As Worksheet, destSH As Worksheet

    Dim srcRng As Range, destRng As Range

    Dim arrIn As Variant, arrOut As Variant

    Dim i As Long, j As Long

    Dim LRow As Long

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

    Const sParolaChiave As String = "Revisionare"              '<<=== Modifica

    Set srcWB = ThisWorkbook

    Set srcSH = srcWB.Sheets(sFoglio)

    With srcSH

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

        Set srcRng = .Range("A1:H" & LRow)

    End With

    arrIn = srcRng.Value

    ReDim arrOut(1 To LRow, 1 To 3)

    For i = 1 To UBound(arrIn)

        If arrIn(i, 8) = sParolaChiave Then

          j = j + 1

          arrOut(j, 1) = arrIn(i, 1)

           arrOut(j, 2) = arrIn(i, 5)

            arrOut(j, 3) = arrIn(i, 7)

        End If

    Next i

    Set destWB = Workbooks.Add(xlWBATWorksheet)

    Set destSH = destWB.Sheets(1)

    Set destRng = destSH.Range("A2").Resize(j, 3)

    destRng.Value = arrOut

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

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

• 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

===

Regards,

Norman