Copiare celle a tutte le cartelle di lavoro in una cartella utilizzando VBA in Microsoft Excel
In questo articolo, creeremo una macro per copiare le celle in tutte le cartelle di lavoro in una cartella.
Abbiamo utilizzato alcuni file Excel di esempio come dati grezzi. Questi file contengono i dettagli delle presenze dei dipendenti. Ogni file contiene data, ID dipendente e nome dei dipendenti. Vogliamo aggiungere intestazioni a tutti i file all’interno della cartella.
Quando si esegue la macro, i dati nell’intervallo da H8 a J10 verranno incollati come intestazione in tutti i fogli Excel all’interno della cartella.
Spiegazione del codice
FolderPath = Sheet1.TextBox1.Value Il codice precedente viene utilizzato per assegnare un valore nella casella di testo per menzionare la variabile.
Dir (FolderPath & “* .xlsx”)
Il codice sopra viene utilizzato per ottenere il nome del file del primo file all’interno del percorso della cartella specificato.
Mentre FileName <> “”
Count1 = Count1 + 1 ReDim Preserve FileArray (1 To Count1)
FileArray (Count1) = FileName FileName = Dir ()
Wend Il codice precedente viene utilizzato per creare un array di stringhe. Contiene i nomi dei file di tutti i file all’interno della cartella.
Workbooks.Open (FolderPath & FileArray (i))
Il codice precedente viene utilizzato per aprire la cartella di lavoro specificata.
SourceWB.Worksheets (1) .Range (“H8: J10”). Copia DestWB.Worksheets (1) .Range (“A1: C3”)
Il codice sopra viene utilizzato per copiare l’intestazione dalla cartella di lavoro principale ad altre cartelle di lavoro.
Segui sotto per il codice
Option Explicit
Sub CopyingDataToFilesInFolder()
'Declaring variables
Dim FileName, FolderPath, FileArray() As String
Dim Count1, i As Integer
Dim SourceWB, DestWB As Workbook
'Getting folder path from the text box
FolderPath = Sheet1.TextBox1.Value
If Right(FolderPath, 1) <> "\" Then
FolderPath = FolderPath & "\"
End If
'Getting the file name from the folder
FileName = Dir(FolderPath & "*.xlsx")
Count1 = 0
'Creating an array which consists of file name of all files in the folder
While FileName <> ""
Count1 = Count1 + 1
ReDim Preserve FileArray(1 To Count1)
FileArray(Count1) = FileName
FileName = Dir()
Wend
Set SourceWB = ThisWorkbook
For i = 1 To UBound(FileArray)
'Opening the workbook
Set DestWB = Workbooks.Open(FolderPath & FileArray(i))
'Pasting the required header
SourceWB.Worksheets(1).Range("H8:J10").Copy DestWB.Worksheets(1).Range("A1:C3")
'Closing the workbook
DestWB.Close True
Next
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]