Tách Nhiều Sheet từ File này sang 1 file khác chứa các sheet cần tách? (1 người xem)

[nqdn2010]

Tôi có File đính kèm, Tôi muốn tách tất cả các sheet có tên 2 chữ cái đầu là "DS" sang 1 file mới duy nhất chứa các sheet "DS.." ;ở file Mau
Số Sheet có tên "DS" thay đổi, ở trong File Mau ví dụ chỉ có 4 sheet, quá trình làm việc có thể nhiều hơn hoặc ít hơn 4 sheet.
Tôi tách thành từng file thì được. Nhưng muốn tách các sheet ra cùng 1 file thì bí. Cụ thể trong vu dụ trên khi tách sẻ tạo ra 1 File mới gồm có 4 Sheet (DS1, DS2, DS3, DS4). Mong mọi người chia sẻ. Thank

 

[levant0908]

Tôi có File đính kèm, Tôi muốn tách tất cả các sheet có tên 2 chữ cái đầu là "DS" sang 1 file mới duy nhất chứa các sheet "DS.." ;ở file Mau
Số Sheet có tên "DS" thay đổi, ở trong File Mau ví dụ chỉ có 4 sheet, quá trình làm việc có thể nhiều hơn hoặc ít hơn 4 sheet.
Tôi tách thành từng file thì được. Nhưng muốn tách các sheet ra cùng 1 file thì bí. Cụ thể trong vu dụ trên khi tách sẻ tạo ra 1 File mới gồm có 4 Sheet (DS1, DS2, DS3, DS4). Mong mọi người chia sẻ. Thank

Em gửi bác.
Em cho copy toàn bộ tên Sheet bắt đầu bằng DS qua 1 file đang đóng theo điều kiện:
1. Tên file là "Danh Sach" , file này phải ở cùng thư mục với File mẫu. (Bác muốn đổi tên File thì edit lại chỗ Workbooks.open trong VBA nha)
2. Nếu tên Sheet bị trùng thì nó tự tạo thêm 1 Sheet khác và đổi tên. (VD như DS1 đã có rồi thì DS1 qua file đích sẽ là DS1 (1) ).
Chúc bác may mắn

 

[VetMini]

Tôi có File đính kèm, Tôi muốn tách tất cả các sheet có tên 2 chữ cái đầu là "DS" sang 1 file mới duy nhất chứa các sheet "DS.." ..
Thank

Giải pháp cho "file mới':
Mở file mẫu ra, xoá tất cả các sheets không bắt đầu bằng "DS". Và save as file mới.

Bộ tiếng Việt "cám ơn" khó nói lắm sao mà phải dùng tiếng Tây? Hay là tại thích tây đa?

 

[đungtb2]

Tôi có File đính kèm, Tôi muốn tách tất cả các sheet có tên 2 chữ cái đầu là "DS" sang 1 file mới duy nhất chứa các sheet "DS.." ;ở file Mau
Số Sheet có tên "DS" thay đổi, ở trong File Mau ví dụ chỉ có 4 sheet, quá trình làm việc có thể nhiều hơn hoặc ít hơn 4 sheet.
Tôi tách thành từng file thì được. Nhưng muốn tách các sheet ra cùng 1 file thì bí. Cụ thể trong vu dụ trên khi tách sẻ tạo ra 1 File mới gồm có 4 Sheet (DS1, DS2, DS3, DS4). Mong mọi người chia sẻ. Thank

Bác tham khảo.

Sub export_sheet()

    Dim wk As Worksheet

    Dim wb As Workbook

    Dim str_name As String

    Dim arr() As String


    For Each wk In Worksheets

        If Left(Trim(wk.name), 2) = "DS" Then

            str_name = str_name & "," & wk.name

        End If

    Next wk

    str_name = Right(str_name, Len(str_name) - 1)

    arr = Split(str_name, ",")

    Set wb = Workbooks.Add

    Windows("File Mau.xlsm").Activate

    Sheets(arr).Copy Before:=Workbooks(wb.name).Sheets(1)

End Sub

 

[nqdn2010]

Cám ơn mọi người để, Test thử thấy OK. Để mình ghép vào chương trình, có gì mong mọi người giúp

 

[nqdn2010]

Windows("File Mau.xlsm").Activate

Nếu File name tùy ý thì sao bạn.

 

[nqdn2010]

Ok!
ThisWorkbook.Activate

Bài đã được tự động gộp: 17/2/20

Tôi muốn lưu vào địa chỉ tùy chọn giống Save as, thì thế nào bạn?

 

[befaint]

Giải pháp cho "file mới':
Mở file mẫu ra, xoá tất cả các sheets không bắt đầu bằng "DS". Và save as file mới.

Bộ tiếng Việt "cám ơn" khó nói lắm sao mà phải dùng tiếng Tây? Hay là tại thích tây đa?

Không ăn thua anh ơi. Có bài giải (#4) là bài của anh bị ló ngơ ngay.

 

[nqdn2010]

Kiến thức còn gà, nên thấy code gắng mò được, thông cảm nhe!
Ý mình là hiện thị bảng Save as để lưu lại khi tạo ra được Sheet mới!
Do #4 đúng yêu cầu,chỉ còn thiều save as, mò code tạm hiểu được

 

[VetMini]

Không ăn thua anh ơi. Có bài giải (#4) là bài của anh bị ló ngơ ngay.

Ừ nhỉ. Rừng cây còn nhiều lá. Vả lại lá của mình là lá chuối, bi giờ thiên hạ ăn xôi bọc ny lông

 

[nqdn2010]

Ừ nhỉ. Rừng cây còn nhiều lá. Vả lại lá của mình là lá chuối, bi giờ thiên hạ ăn xôi bọc ny lông

Xin lỗi nhe, Không phải vậy đâu;
- Tôi học lõm code, Bạn chỉ tôi hiểu cách thức nhưng không biết viết code thế nào.
- Bạn có code cụ thể tôi mò mẫm tiếp để áp dụng cho mình.
Thông cảm nhe

Bài đã được tự động gộp: 17/2/20

Do #4 thực hiện tách các Sheet "DS" vào 1 file mới là OK, nhưng tôi muốn tự Save as theo đường dẫn tùy mình chọn!

 

[VetMini]

Muốn hiển thj bảng save as thì dùng phương thức GetSaveAsFilename
wb.SaveAs Filename:=Application.GetSaveAsFilename(filefilter:="Excel files,*.xlsx")

 

[nqdn2010]

Muốn hiển thj bảng save as thì dùng phương thức GetSaveAsFilename
wb.SaveAs Filename:=Application.GetSaveAsFilename(filefilter:="Excel files,*.xlsx")

Cám ơn bạn Tôi áp dụng vào thế này, mong bạn góp ý, tôi còn mờ lắm

Sub export_sheet()
    Dim wk As Worksheet
    Dim wb As Workbook
    Dim str_name As String
    Dim arr() As String
  sPath = CreateObject("Shell.Application").BrowseForFolder(0, TD, 1).Self.Path '
    For Each wk In Worksheets
        If Left(Trim(wk.Name), 2) = "DS" Then
            str_name = str_name & "," & wk.Name
        End If

    Next wk
    str_name = Right(str_name, Len(str_name) - 1)
    arr = Split(str_name, ",")
    Set wb = Workbooks.Add
    ThisWorkbook.Activate
    'Windows("File Mau.xlsm").Activate
    Sheets(arr).Copy Before:=Workbooks(wb.Name).Sheets(1)
     wb.SaveAs FileName:=sPath & "\Danh sach Xuat.xlsx"
    'wb.SaveAs FileName:=Application.GetSaveAsFilename(filefilter:="Excel files,*.xlsx")
End Sub

 

[VetMini]

wb.SaveAs FileName:=Application.GetSaveAsFilename(InitialFilename:=sPath & "\Danh sach Xuat.xlsx", filefilter:="Excel files,*.xlsx")

 

[nqdn2010]

Cám ơn bạn nhiều, Mình áp dụng rất tốt, thực hiện tốt yêu cầu, Khi có vấn đề phát sinh rất mong sự chỉ giáo..