Tach Sheet từ 1 File thanh nhiều File khác. (1 người xem)

[phuyen89]

Chào Anh/ Chị GPE.
Em viêt một đoạn Code phục vụ cho việc tách mỗi Sheet trong 1 File thành nhiều Workbook khác nhau, mỗi Workbook là 1 sheet trong File ban đầu.

Sub TestApi()
Dim Ws As Worksheet
Dim i As Integer
Dim strNameWb As String
i = 1
For Each Ws In Worksheets

i = i + 1
    Ws.Select
    If Sheets.Count > 1 Then
        Ws.Move
        Else
        Exit Sub
    End If
    strNameWb = "book" & i
    Workbooks(strNameWb).Close savechanges:=True, Filename:="File" & i
Next Ws
End Sub

Nhưng em chưa loại bỏ được khả năng, Trong Worksheets mà em ẩn một sheet nào đó, thì tại Method Ws.Select bị lỗi
Mong mọi người giúp đỡ.

 

[Quang_Hải]

Chào Anh/ Chị GPE.
Em viêt một đoạn Code phục vụ cho việc tách mỗi Sheet trong 1 File thành nhiều Workbook khác nhau, mỗi Workbook là 1 sheet trong File ban đầu.

Sub TestApi()
Dim Ws As Worksheet
Dim i As Integer
Dim strNameWb As String
i = 1
For Each Ws In Worksheets

i = i + 1
    Ws.Select
    If Sheets.Count > 1 Then
        Ws.Move
        Else
        Exit Sub
    End If
    strNameWb = "book" & i
    Workbooks(strNameWb).Close savechanges:=True, Filename:="File" & i
Next Ws
End Sub

Nhưng em chưa loại bỏ được khả năng, Trong Worksheets mà em ẩn một sheet nào đó, thì tại Method Ws.Select bị lỗi
Mong mọi người giúp đỡ.

Trước khi Select thì thêm dòng Ws.Visible=True

 

[ndu96081631]

Chào Anh/ Chị GPE.
Em viêt một đoạn Code phục vụ cho việc tách mỗi Sheet trong 1 File thành nhiều Workbook khác nhau, mỗi Workbook là 1 sheet trong File ban đầu.

Sub TestApi()
Dim Ws As Worksheet
Dim i As Integer
Dim strNameWb As String
i = 1
For Each Ws In Worksheets

i = i + 1
    Ws.Select
    If Sheets.Count > 1 Then
        Ws.Move
        Else
        Exit Sub
    End If
    strNameWb = "book" & i
    Workbooks(strNameWb).Close savechanges:=True, Filename:="File" & i
Next Ws
End Sub

Nhưng em chưa loại bỏ được khả năng, Trong Worksheets mà em ẩn một sheet nào đó, thì tại Method Ws.Select bị lỗi
Mong mọi người giúp đỡ.

- Thứ nhất: Cái nào ẩn thì cho nó hiện ra
- Thứ hai: Move (hay gì gì đó) cũng không cần phải Select
- Thứ ba: Bài này dùng Do.. Loop hay hơn For.. Next (vì mỗi lần move bớt 1 sheet thì sheets.count bị thay đổi)
Tôi đề xuất code sau:

Sub TestApi()
  Dim i As Long, path As String, wks As Worksheet
  path = ThisWorkbook.path
  i = 1
  Do While Worksheets.Count > 1
    i = i + 1
    Set wks = Worksheets(2)
    If wks.Visible <> -1 Then wks.Visible = -1
    wks.Move: ActiveWorkbook.Close True, path & "\File" & i
  Loop
End Sub

------------------------------
- Thứ tư: Cái này nói thêm một chút rằng bạn phải tính đến trường hợp lưu file bị trùng tên với file có sẵn (tự tính nhé)... và vẫn còn nhiều lỗi khác mà bạn cần phải tính đến (ví dụ như Define name bị dời theo... vân vân...)

 

[phuyen89]

Em cảm ơn Thầy và anh Hà.
Trước khi em có ý định move sheet thì em đã chạy code Paste Value hết các Sheet rồi.
Còn 3 sheet ẩn [ sheet chính để chạy ra các sheet con] là em cố tình cho nó không bị tách, nên em mới ẩn như vậy!
Vậy em phải bẫy lỗi khi vòng Lặp duyệt qua các sheet cố tình Ẩn này, hay có phương án nào khác hay hơn!
Mong Thầy, anh Hà cho em ý hướng làm.

 

[Quang_Hải]

Em cảm ơn Thầy và anh Hà.
Trước khi em có ý định move sheet thì em đã chạy code Paste Value hết các Sheet rồi.
Còn 3 sheet ẩn [ sheet chính để chạy ra các sheet con] là em cố tình cho nó không bị tách, nên em mới ẩn như vậy!
Vậy em phải bẫy lỗi khi vòng Lặp duyệt qua các sheet cố tình Ẩn này, hay có phương án nào khác hay hơn!
Mong Thầy, anh Hà cho em ý hướng làm.

Vậy sửa thử vầy coi sao
If WS.Visible = True Then Ws.Move

 

[tueyennhi]

- Thứ nhất: Cái nào ẩn thì cho nó hiện ra
- Thứ hai: Move (hay gì gì đó) cũng không cần phải Select
- Thứ ba: Bài này dùng Do.. Loop hay hơn For.. Next (vì mỗi lần move bớt 1 sheet thì sheets.count bị thay đổi)
Tôi đề xuất code sau:

Sub TestApi()
  Dim i As Long, path As String, wks As Worksheet
  path = ThisWorkbook.path
  i = 1
  Do While Worksheets.Count > 1
    i = i + 1
    Set wks = Worksheets(2)
    If wks.Visible <> -1 Then wks.Visible = -1
    wks.Move: ActiveWorkbook.Close True, path & "\File" & i
  Loop
End Sub

------------------------------
- Thứ tư: Cái này nói thêm một chút rằng bạn phải tính đến trường hợp lưu file bị trùng tên với file có sẵn (tự tính nhé)... và vẫn còn nhiều lỗi khác mà bạn cần phải tính đến (ví dụ như Define name bị dời theo... vân vân...)

Em đã thử code này thì thấy lỗi không giữ nguyên định dạng màu trong ô, thầy giải đáp giúp em với.