复制细胞的所有工作簿在Excel中使用VBA文件夹中

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