Trong bài viết này, chúng tôi sẽ tạo một macro để sao chép các ô vào tất cả các sổ làm việc trong một thư mục.

Chúng tôi đã sử dụng một số tệp Excel mẫu làm dữ liệu thô. Các tệp này chứa thông tin chi tiết về sự tham gia của các nhân viên. Mỗi tệp chứa Ngày, Id nhân viên và Tên của nhân viên. Chúng tôi muốn thêm tiêu đề vào tất cả các tệp trong thư mục.

ArrowMain

ArrowFilesInFolder

ArrowRawData

Khi chạy macro, dữ liệu trong phạm vi H8 đến J10 sẽ được dán làm tiêu đề trong tất cả các trang tính Excel trong thư mục.

ArrowOutput

Giải thích mã

FolderPath = Sheet1.TextBox1.Value Đoạn mã trên được sử dụng để gán giá trị trong hộp văn bản để đề cập đến biến.

Dir (FolderPath & “* .xlsx”)

Đoạn mã trên được sử dụng để lấy tên tệp của tệp đầu tiên trong đường dẫn thư mục được chỉ định.

Trong khi Tên tệp <> “”

Count1 = Count1 + 1 ReDim Bảo quản FileArray (1 đến đếm1)

FileArray (Count1) = FileName FileName = Dir ()

Wend Đoạn mã trên được sử dụng để tạo một mảng chuỗi. Nó chứa tên tệp của tất cả các tệp trong thư mục.

Workbooks.Open (FolderPath & FileArray (i))

Đoạn mã trên được sử dụng để mở sổ làm việc được chỉ định.

SourceWB.Worksheets (1) .Range (“H8: J10”). Sao chép DestWB.Worksheets (1) .Range (“A1: C3”)

Đoạn mã trên được sử dụng để sao chép tiêu đề từ sổ làm việc chính sang các sổ làm việc khác.

Vui lòng theo dõi bên dưới để biết mã

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

Nếu bạn thích blog này, hãy chia sẻ nó với bạn bè của bạn trên Facebook và Facebook.

Chúng tôi rất muốn nghe ý kiến ​​từ bạn, hãy cho chúng tôi biết cách chúng tôi có thể cải thiện công việc của mình và làm cho nó tốt hơn cho bạn. Viết thư cho chúng tôi [email protected]