Copiare un range da ogni cartella di lavoro in una cartella utilizzando VBA in Microsoft Excel
In questo articolo creeremo una macro per copiare i dati da più cartelle di lavoro in una cartella in una nuova cartella di lavoro.
Creeremo due macro; una macro copierà solo i record dalla prima colonna alla nuova cartella di lavoro e la seconda macro copierà tutti i dati al suo interno.
I dati grezzi per questo esempio sono costituiti dai record di presenza dei dipendenti.
In TestFolder, abbiamo più file Excel. I nomi dei file di Excel rappresentano una data particolare nel formato “ggmmaaaa”.
Ogni file Excel contiene la data, l’ID del dipendente e il nome del dipendente di quei dipendenti che erano presenti in quel particolare giorno.
Abbiamo creato due macro; “CopyingSingleColumnData” e “CopyingMultipleColumnData”. La macro “CopyingSingleColumnData” copierà solo i record dalla prima colonna di tutti i file nella cartella alla nuova cartella di lavoro. La macro “CopyingMultipleColumnData” copierà tutti i dati da tutti i file nella cartella nella nuova cartella di lavoro.
La macro “CopyingSingleColumnData” può essere eseguita facendo clic sul pulsante “Copying Single Column”. La macro “CopyingMultipleColumnData” può essere eseguita facendo clic sul pulsante “Copia di più colonne”.
Prima di eseguire la macro, è necessario specificare il percorso della cartella nella casella di testo, dove vengono inseriti i file Excel.
Quando si fa clic sul pulsante “Copia singola colonna”, verrà generata una nuova cartella di lavoro “ConsolidatedFile” nella cartella definita. Questa cartella di lavoro conterrà i dati consolidati dalla prima colonna di tutti i file nella cartella.
La nuova cartella di lavoro sarà contenere solo record nella prima colonna. Una volta che abbiamo i dati consolidati, possiamo scoprire il numero di dipendenti presenti in un determinato giorno contando il numero di date. Il conteggio di una determinata data sarà uguale al numero di dipendenti presenti in quella particolare giorno.
Quando si fa clic sul pulsante “Copia di più colonne”, verrà generata la nuova cartella di lavoro “ConsolidatedAllColumns” nella cartella definita. Questa cartella di lavoro conterrà i dati consolidati di tutti i record di tutti i file nella cartella.
La nuova cartella di lavoro creata conterrà tutti i record di tutti i file nella cartella. Una volta che abbiamo i dati consolidati, abbiamo tutti i dettagli delle presenze disponibili in un unico file. Possiamo facilmente trovare il numero di dipendenti presenti in quel particolare giorno e anche ottenere i nomi dei dipendenti che erano presenti in quel particolare giorno.
Spiegazione del codice
Sheet1.TextBox1.Value Il codice sopra è utilizzato per ottenere il valore inserito nella casella di testo “TextBox1” dal foglio “Sheet1”.
Dir (FolderPath & “* .xlsx”)
Il codice sopra viene utilizzato per ottenere il nome del file, che ha l’estensione “.xlsx”. Abbiamo utilizzato il carattere jolly * per il nome del file con più caratteri.
Mentre FileName <> “”
Count1 = Count1 + 1 ReDim Preserve FileArray (1 To Count1)
FileArray (Count1) = FileName FileName = Dir ()
Il codice Wend Above viene utilizzato per ottenere i nomi dei file di tutti i file nella cartella.
Per i = 1 a UBound (FileArray)
Il codice successivo sopra viene utilizzato per scorrere tutti i file nella cartella.
Intervallo (“A1”, Celle (LastRow, 1)). Copia DestWB.ActiveSheet.Cells (LastDesRow, 1)
Il codice sopra viene utilizzato per copiare il record dalla prima colonna alla cartella di lavoro di destinazione.
Intervallo (“A1”, ActiveCell.SpecialCells (xlCellTypeLastCell)). Copia DestWB.ActiveSheet.Cells (LastDesRow, 1)
Il codice sopra viene utilizzato per copiare tutto il record dalla cartella di lavoro attiva alla cartella di lavoro di destinazione.
Segui sotto per il codice
Option Explicit
Sub CopyingSingleColumnData()
'Declaring variables
Dim FileName, FolderPath, FileArray(), FileName1 As String
Dim LastRow, LastDesRow, Count1, i As Integer
Dim SourceWB, DestWB As Workbook
Application.ScreenUpdating = False
FolderPath = Sheet1.TextBox1.Value
'Inserting backslash in the folder path if backslash(\) is missing
If Right(FolderPath, 1) <> "\" Then
FolderPath = FolderPath & "\"
End If
'Searching for Excel files
FileName = Dir(FolderPath & "*.xlsx")
Count1 = 0
'Looping through all the Excel files in the folder
While FileName <> ""
Count1 = Count1 + 1
ReDim Preserve FileArray(1 To Count1)
FileArray(Count1) = FileName
FileName = Dir()
Wend
'Creating a new workbook
Set DestWB = Workbooks.Add
For i = 1 To UBound(FileArray)
'Finding the last row in the workbook
LastDesRow = DestWB.ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row
'Opening the Excel workbook
Set SourceWB = Workbooks.Open(FolderPath & FileArray(i))
LastRow = ActiveCell.SpecialCells(xlCellTypeLastCell).Row
'Pasting the copied data to last row in the destination workbook
If LastDesRow = 1 Then
'Copying the first column to last row in the destination workbook
Range("A1", Cells(LastRow, 1)).Copy DestWB.ActiveSheet.Cells(LastDesRow, 1)
Else
Range("A1", Cells(LastRow, 1)).Copy DestWB.ActiveSheet.Cells(LastDesRow + 1, 1)
End If
SourceWB.Close False
Next
'Saving and closing a new Excel workbook
DestWB.SaveAs FileName:=FolderPath & "ConsolidatedFile.xlsx"
DestWB.Close
Set DestWB = Nothing
Set SourceWB = Nothing
End Sub
Sub CopyingMultipleColumnData()
'Declaring variables
Dim FileName, FolderPath, FileArray(), FileName1 As String
Dim LastRow, LastDesRow, Count1, i As Integer
Dim SourceWB, DestWB As Workbook
Application.ScreenUpdating = False
FolderPath = Sheet1.TextBox1.Value
'Inserting backslash in the folder path if backslash(\) is missing
If Right(FolderPath, 1) <> "\" Then
FolderPath = FolderPath & "\"
End If
'Searching for Excel files
FileName = Dir(FolderPath & "*.xlsx")
Count1 = 0
'Looping through all the Excel files in the folder
While FileName <> ""
Count1 = Count1 + 1
ReDim Preserve FileArray(1 To Count1)
FileArray(Count1) = FileName
FileName = Dir()
Wend
'Creating a new workbook
Set DestWB = Workbooks.Add
For i = 1 To UBound(FileArray)
'Finding the last row in the workbook
LastDesRow = DestWB.ActiveSheet.Range("A1").SpecialCells(xlCellTypeLastCell).Row
'Opening the Excel workbook
Set SourceWB = Workbooks.Open(FolderPath & FileArray(i))
'Pasting the copied data to last row in the destination workbook
If LastDesRow = 1 Then
'Copying all data in the worksheet to last row in the destination workbook
Range("A1", ActiveCell.SpecialCells(xlCellTypeLastCell)).Copy DestWB.ActiveSheet.Cells(LastDesRow, 1)
Else
Range("A1", ActiveCell.SpecialCells(xlCellTypeLastCell)).Copy DestWB.ActiveSheet.Cells(LastDesRow + 1, 1)
End If
SourceWB.Close False
Next
'Saving and closing a new Excel workbook
DestWB.SaveAs FileName:=FolderPath & "ConsolidatedAllColumns.xlsx"
DestWB.Close
Set DestWB = Nothing
Set SourceWB = Nothing
End Sub
Se ti è piaciuto questo blog, condividilo con i tuoi amici su Facebook e Facebook.
Ci piacerebbe sentire la tua opinione, facci sapere come possiamo migliorare il nostro lavoro e renderlo migliore per te. Scrivici a [email protected]