Code copy và paste công thức các file trong thư mục (1 người xem)

[kydang1989]

Hàng tháng mình đều làm 1 công việc như nhau đó là khi nhận dữ liệu từ các xưởng sẽ vào file congthuc.xlsx copy công thức, sau đó mở từng file dữ liệu paste công thức vào.
các file đều có cấu trúc giống nhau.
Ví dụ, trong tháng 9, nhận dữ liệu XuongA.xlsx, XuongB.xlsx....sẽ vào file congthuc.xlsx copy công thức paste vào file XuongA, XUongB... (paste từ ô X1:AH...)
Mình muốn khi mở file congthuc.xlsx, (không mở file dữ liệu) thì khi chạy macro , sẽ hiện lên bảng tìm đường dẫn đến các file cần paste công thức. sau đó sẽ tự động paste công thức vào các file đã chọn.


(paste luôn công thức vào. các file dữ liệu sẽ thấy công thức)
trong file đính kèm: file XuongA.xlsx, XuongB.xlsx chưa có công thức, cần paste công thức từ file congthuc.xlsx vào.
A/ce GPE giúp mình.

 

[Quang_Hải]

Hàng tháng mình đều làm 1 công việc như nhau đó là khi nhận dữ liệu từ các xưởng sẽ vào file congthuc.xlsx copy công thức, sau đó mở từng file dữ liệu paste công thức vào.
các file đều có cấu trúc giống nhau.
Ví dụ, trong tháng 9, nhận dữ liệu XuongA.xlsx, XuongB.xlsx....sẽ vào file congthuc.xlsx copy công thức paste vào file XuongA, XUongB... (paste từ ô X1:AH...)
Mình muốn khi mở file congthuc.xlsx, (không mở file dữ liệu) thì khi chạy macro , sẽ hiện lên bảng tìm đường dẫn đến các file cần paste công thức. sau đó sẽ tự động paste công thức vào các file đã chọn.


(paste luôn công thức vào. các file dữ liệu sẽ thấy công thức)
trong file đính kèm: file XuongA.xlsx, XuongB.xlsx chưa có công thức, cần paste công thức từ file congthuc.xlsx vào.
A/ce GPE giúp mình.

Cho code này vào file congthuc

Sub Mo_Nhieu_File_De_Copy_CT()
Dim FilesToOpen As Variant, x As Long
Dim TieuDe As Range, CongThuc As Range
Set TieuDe = [X1:AH1]
Set CongThuc = [X2:AH2]
FilesToOpen = Application.GetOpenFilename("Excel Files,*.xls?", , , , True)
If Not IsArray(FilesToOpen) Then Exit Sub
For x = 1 To UBound(FilesToOpen)
   Workbooks.Open FilesToOpen(x)
   With ActiveWorkbook
      With .ActiveSheet
         TieuDe.Copy .[X1]
         CongThuc.Copy .[X2]
         .Range(.[A2], .[A65536].End(3)).Offset(, 23).Resize(, 11).FillDown
      End With
      .Close True
   End With
Next
End Sub

 

[kydang1989]

Cho code này vào file congthuc

Sub Mo_Nhieu_File_De_Copy_CT()
Dim FilesToOpen As Variant, x As Long
Dim TieuDe As Range, CongThuc As Range
Set TieuDe = [X1:AH1]
Set CongThuc = [X2:AH2]
FilesToOpen = Application.GetOpenFilename("Excel Files,*.xls?", , , , True)
If Not IsArray(FilesToOpen) Then Exit Sub
For x = 1 To UBound(FilesToOpen)
   Workbooks.Open FilesToOpen(x)
   With ActiveWorkbook
      With .ActiveSheet
         TieuDe.Copy .[X1]
         CongThuc.Copy .[X2]
         .Range(.[A2], .[A65536].End(3)).Offset(, 23).Resize(, 11).FillDown
      End With
      .Close True
   End With
Next
End Sub

Cảm ơn anh đã giúp đỡ !