Unire due fogli excel includendo le Macro

Question

Ciao a tutti !!!

Ho due Fogli excel 1 e 2, ciascuno dei quali opera con delle macro.

Ho necessità di integrare il Foglio 2 (comprensivo delle sue macro) nel Foglio 1 in modo tale da avere un Foglio unico.

Grazie

Answer 1

Ciao Torical,

Qualche chiarimento in merito al codice VBA.

1. Const sFile1 As String = "FileA.xlsm" '<<=== Modifica

Const sFile2 As String = "FileB.xlsm" '<<=== Modifica

Const sPercorso As String = "C:\Users\Torical\Documents" '<<=== Modifica

Const sNome_Del_File_Combinata As String = "File_Combinato.xlsm" '<<=== Modifica

Il file combinato è una nuova cartella di lavoro excel che devo creare io ex novo oppure viene creato in automatico dopo aver eseguito il comando VBA ?

Il file File_Combinato.xlsm viene creato dal codice. Questo file comprende il codice del FileB.xlsm e con un foglio contenente i dati di entrambi i file FileA.xlsm e FileB.xlsm

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

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

Alle voci Foglio 1 della prima e seconda cartella nel comando VBA devo mettere tutti nomi dei fogli presenti della cartella di riferimento ?

Se si e se sono presenti più di un foglio nella cartella di riferimento quale è il codice corretto da scrivere ( dato che nel codice che hai scritto è presente solo il " Foglio 1 "?

Come scritto, il mio codice combina i dati di un unico foglio da ciascuno dei due file di interesse. Se i dati di più fogli di ciascuno dei due file esistenti devono essere combinati nel nuovo file, il codice dovrà essere rivisto.

In tal caso, ti chiedo gentilmente di caricare due file di esempio e di indicare anche l'ordine in cui i dati dei vari fogli devono apparire nel foglio di output del nuovo file.

Ti chiederei inoltre di confermare che il codice che apparirà nella nuova cartella di lavoro proviene esclusivamente da FileB.xlsm

===

Regards,

Norman

Answer 2

Ciao Norman !!

Qualche chiarimento in merito al codice VBA.

1. Const sFile1 As String = "FileA.xlsm" '<<=== Modifica

Const sFile2 As String = "FileB.xlsm" '<<=== Modifica

Const sPercorso As String = "C:\Users\Torical\Documents" '<<=== Modifica

Const sNome_Del_File_Combinata As String = "File_Combinato.xlsm" '<<=== Modifica

Il file combinato è una nuova cartella di lavoro excel che devo creare io ex novo oppure viene creato in automatico dopo aver eseguito il comando VBA ?

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

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

Alle voci Foglio 1 della prima e seconda cartella nel comando VBA devo mettere tutti nomi dei fogli presenti della cartella di riferimento ?

Se si e se sono presenti più di un foglio nella cartella di riferimento quale è il codice corretto da scrivere ( dato che nel codice che hai scritto è presente solo il " Foglio 1 "?

Answer 3

Ciao Torical,

Devo fare una rettifica perchè trattasi di 2 cartelle di lavoro.

Sono stato ingannato perchè cliccando col tasto destro sul desktop mi da l'opzione " Apri nuovo foglio di lavoro di Microsoft Excel " e quindi ho scritto la dicitura errata.

Comunque grazie anche per questa nuova opzione mi potrebbe tornare utile in futuro.

Attendo nuovo codice VBA per l'unione di due cartelle excel.

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

'-------->>

Public Sub Tester()

Dim WB1 As Workbook, WB2 As Workbook, destWB As Workbook 

Dim SH1 As Worksheet, SH2 As Worksheet, destSH As Worksheet 

Dim srcRng As Range, Rng1 As Range, Rng2 As Range, destRng As Range 

Dim iRow As Long 

Const sFile1 As String = **"FileA.xlsm"                                                            '<<=== Modifica** 

Const sFile2 As String = **"FileB.xlsm"                                                            '<<=== Modifica** 

Const sPercorso As String = **"C:\Users\Torical\Documents\"                      '<<=== Modifica**  

Const sNome\_Del\_File\_Combinata As String = **"File\_Combinato.xlsm"       '<<=== Modifica** 

Const sFoglio1 As String = **"Foglio1"                                                            '<<=== Modifica** 

Const sFoglio2 As String = **"Foglio1"                                                            '<<=== Modifica** 

Application.ScreenUpdating = False 

Set WB1 = Workbooks.Open(sPercorso & sFile1) 

Set WB2 = Workbooks.Open(sPercorso & sFile2) 

Set SH1 = WB1.Sheets(sFoglio1) 

WB2.SaveAs sPercorso & sNome\_Del\_File\_Combinata 

Set destWB = ActiveWorkbook 

Set destSH = destWB.Sheets(sFoglio1) 

iRow = LastRow(SH1) 

Set srcRng = SH1.Rows(1).Resize(iRow) 

destSH.Range("A1").EntireRow.Resize(iRow).Insert Shift:=xlDown 

srcRng.Copy Destination:=destSH.Range("A1") 

Application.ScreenUpdating = True 

destWB.Save 

    WB1.Close savechanges:=False 

        Call MsgBox(Prompt:="Finito!", \_ 

        Buttons:=vbInformation, \_ 

        Title:="REPORT") 

ThisWorkbook.Close savechanges:=False 

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 Torical20220308.xlsm

Come precedentemente indicato,, a causa di un problema con l'attuale editor del forum, che inserisce righe vuote indesiderate nel codice copiato dal forum, suggerirei di copiare il mio codice direttamente dal mio file di prova.

===

Regards,

Norman

Answer 4

Bentornato Norman !!

Devo fare una rettifica perchè trattasi di 2 cartelle di lavoro.

Sono stato ingannato perchè cliccando col tasto destro sul desktop mi da l'opzione " Apri nuovo foglio di lavoro di Microsoft Excel " e quindi ho scritto la dicitura errata.

Comunque grazie anche per questa nuova opzione mi potrebbe tornare utile in futuro.

Attendo nuovo codice VBA per l'unione di due cartelle excel.

Saluti

Answer 5

Ciao Torical,

Ho due Fogli excel 1 e 2, ciascuno dei quali opera con delle macro.

Ho necessità di integrare il Foglio 2 (comprensivo delle sue macro) nel Foglio 1 in modo tale da avere un Foglio unico.

A condizione che si tratti di due fogli di lavoro anziché di due cartelle di lavoro e che il codice di interesse sia il codice evento, provare qualcosa del genere:

'========>>

Option Explicit

'-------->>

Public Sub Tester()

Dim SH1 As Worksheet, SH2 As Worksheet 

Dim Rng1 As Range, Rng2 As Range 

Dim vFilename As Variant 

Dim LRow As Long, iRows As Long 

Const sFoglio1 As String = **"Foglio1"                                               '<<=== Modifica** 

Const sFoglio2 As String = **"Foglio2"                                               '<<=== Modifica** 

Const sNome\_Nuovo\_Foglio As String = **"Foglio\_combinato"       '<<=== Modifica** 

With ActiveWorkbook 

    Set SH1 = .Sheets(sFoglio1) 

    Set SH2 = .Sheets(sFoglio2) 

End With 

SH2.Copy 

Set Rng1 = SH1.UsedRange 

Set Rng2 = SH2.UsedRange 

iRows = Rng2.Rows.Count 

With ActiveSheet 

    .Name = sNome\_Nuovo\_Foglio 

    .Range("A1").EntireRow.Resize(iRows).Insert Shift:=xlDown 

    Rng1.Copy Destination:=.Range("A1") 

End With 

vFilename = Application.GetSaveAsFilename( \_ 

    fileFilter:="File Excel (\*.xlsm), \*.xlsm") 

If vFilename = False Then 

    Call MsgBox(Prompt:="Non hai selezionato un nome per il nuovo file e quindi non è stato salvato! ", \_ 

        Buttons:=vbInformation, \_ 

        Title:="REPORT") 

    Exit Sub 

End If 

ActiveWorkbook.SaveAs Filename:=vFilename, FileFormat:=52 

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

'<<========

Potresti scaricare il mio file di prova Torical20220307.xlsm

A causa di un problema con l'attuale editor del forum, che inserisce righe vuote indesiderate nel codice copiato dal forum, suggerirei di copiare il mio codice direttamente dal mio file di prova.

===

Regards,

Norman