Copy sang các file trong các thư mục khác nhau

[hongphuong1997]

Cháu nhờ các Bác và Anh chị giúp cháu bài như file đính kèm ạ
Cháu cảm ơn ạ

 

[hongphuong1997]

huhu.....buồn quá anh @BuiQuangThuan anh @Hoàng Tuấn 868 oi các anh viết cho em với

 

[BuiQuangThuan]

huhu.....buồn quá anh @BuiQuangThuan anh @Hoàng Tuấn 868 oi các anh viết cho em với

Bạn thua rồi à.....rồi muốn có thành quả lại phải chờ à

 

[Maika8008]

Hihi..... nói thật sự với anh, em tuy hỏi bài cực nhiều và cũng được rất nhiều anh chị và các Bác siêu cao thủ trên GPE dạy dỗ rất nhiệt tình:
Nhưng thực tình em không thể tự viết code được
Em thật sự đáng buồn về bộ não của em.

"các Bác siêu cao thủ trên GPE" -> đừng viết hoa chữ bác bạn nhé! Bác trong lăng mới phải viết hoa còn bác trong GPE mà bị viết hoa thì sợ lắm.

 

[hongphuong1997]

Trước em có sưu tầm được sub() copy này nhưng em không nhớ là của ai?
Code chạy thì rất chuẩn, nhưng mỗi tội là chỉ copy được các file ở trong 1 thư mục (Chắc là sẽ copy được nhiều thư mục ; nhưng em không biết nguyên lý của nó nên không chỉnh sửa được.
Các anh chỉnh sửa cho em với
Em cảm ơn ạ

Public Sub OpenAllFileInFolder2()
tg = Timer
    Dim FSO As Object, ChonFolder As Object, MyFile As Object, Path  As String, TypeF As String
    Dim wk As Workbook
    Dim DefaultRange As String, UserRange As Range, RangePaste As String

DefaultRange = Selection.Address
Set UserRange = Application.InputBox _
        (Prompt:="Select data:", _
        Title:="Copy to all file", _
        Default:=DefaultRange, _
        Type:=8)
RangePaste = UserRange(1, 1).Address
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Path = ThisWorkbook.Path
Set FSO = CreateObject("Scripting.FilesyStemObject")
Set ChonFolder = FSO.GetFolder(Path)
For Each MyFile In ChonFolder.Files
    TypeF = FSO.GetExtensionName(MyFile)
    If MyFile.Name <> ThisWorkbook.Name Then
        If TypeF Like "*xls*" Then
            Set wk = Workbooks.Open(MyFile.Path)
            With Sheets("Nguon")
                UserRange.copy .Range(RangePaste)
            
        End With
    End If
    wk.Close True
End If
Next MyFile
Thoat:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
 
End Sub

 

[snow25]

Trước em có sưu tầm được sub() copy này nhưng em không nhớ là của ai?
Code chạy thì rất chuẩn, nhưng mỗi tội là chỉ copy được các file ở trong 1 thư mục (Chắc là sẽ copy được nhiều thư mục ; nhưng em không biết nguyên lý của nó nên không chỉnh sửa được.
Các anh chỉnh sửa cho em với
Em cảm ơn ạ

Public Sub OpenAllFileInFolder2()
tg = Timer
    Dim FSO As Object, ChonFolder As Object, MyFile As Object, Path  As String, TypeF As String
    Dim wk As Workbook
    Dim DefaultRange As String, UserRange As Range, RangePaste As String

DefaultRange = Selection.Address
Set UserRange = Application.InputBox _
        (Prompt:="Select data:", _
        Title:="Copy to all file", _
        Default:=DefaultRange, _
        Type:=8)
RangePaste = UserRange(1, 1).Address
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Path = ThisWorkbook.Path
Set FSO = CreateObject("Scripting.FilesyStemObject")
Set ChonFolder = FSO.GetFolder(Path)
For Each MyFile In ChonFolder.Files
    TypeF = FSO.GetExtensionName(MyFile)
    If MyFile.Name <> ThisWorkbook.Name Then
        If TypeF Like "*xls*" Then
            Set wk = Workbooks.Open(MyFile.Path)
            With Sheets("Nguon")
                UserRange.copy .Range(RangePaste)
           
        End With
    End If
    wk.Close True
End If
Next MyFile
Thoat:
Application.DisplayAlerts = True
Application.ScreenUpdating = True
 
End Sub

Thêm cái vòng lặp for ở chỗ chọn Folder là được.Nếu dữ liệu được đánh số theo số thứ tự thì có thể dùng được ADO để cập nhập dữ liệu vào.

 

[hongphuong1997]

Thêm cái vòng lặp for ở chỗ chọn Folder là được.Nếu dữ liệu được đánh số theo số thứ tự thì có thể dùng được ADO để cập nhập dữ liệu vào.

Anh oi, anh viết cho em với lâu lắm rùi em chẳng thấy anh viết giúp mọi người gì cả