[Help] Cách tách sheet protect dữ liệu hoặc chỉ copy value dữ liệu sang file excel mới (1 người xem)

[dungnh1501]

Mình đang muốn tách cách sheet trong 1 file excel ra thành cách file excel mới, nhưng khi tách ra thì nó ăn cả công thức của sheet cũ (trong sheet cũ có filter). Mình muốn copy chỉ lấy ra phần dữ liệu đang hiển thị, hoặc protect không cho chỉnh sửa trên file excel mới đó. mọi người giúp mình với

 

[vanthinh3101]

Mình đang muốn tách cách sheet trong 1 file excel ra thành cách file excel mới, nhưng khi tách ra thì nó ăn cả công thức của sheet cũ (trong sheet cũ có filter). Mình muốn copy chỉ lấy ra phần dữ liệu đang hiển thị, hoặc protect không cho chỉnh sửa trên file excel mới đó. mọi người giúp mình với

Mình thấy bạn lấy code ở bài này http://www.giaiphapexcel.com/diendan/threads/nhờ-sửa-code-tách-sheet-trong-excel.124337/#post-778934
Code này hoạt động tốt, nhưng yêu cầu là phải tách sheet, sau đó từ sheet mới tách rồi mới save as ra 1 file mới.

 

[dungnh1501]

Hic, của bạn có khác gì mình đâu, file của mình đã tách sheet rồi, vì nó đang chạy 2 pivottablet trên 1 sheet nên khôgn thể chạy công thức tách sheet lại được, mình đang cần cái save as file mới mà ra file mới protect hoặc chỉ lấy value hiển thị trên file đó thôi

 

[vanthinh3101]

Hic, của bạn có khác gì mình đâu, file của mình đã tách sheet rồi, vì nó đang chạy 2 pivottablet trên 1 sheet nên khôgn thể chạy công thức tách sheet lại được, mình đang cần cái save as file mới mà ra file mới protect hoặc chỉ lấy value hiển thị trên file đó thôi

Bạn thử upload file lên cho mọi người cùng xem và giải quyết nhé!
Nói không thế này khó giải quyết lắm.

 

[PacificPR]

Mình đang muốn tách cách sheet trong 1 file excel ra thành cách file excel mới, nhưng khi tách ra thì nó ăn cả công thức của sheet cũ (trong sheet cũ có filter). Mình muốn copy chỉ lấy ra phần dữ liệu đang hiển thị, hoặc protect không cho chỉnh sửa trên file excel mới đó. mọi người giúp mình với

Bạn thử sửa lại như thế này xem sao

Sub tachsheet()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim ShMain As Worksheet, Rng As Range, sh As Worksheet
    
For Each ShMain In Worksheets
    Set Rng = ShMain.Range("A1").CurrentRegion
    With Workbooks.Add
        Set sh = .Sheets(1)
        sh.Name = ShMain.Name
        ShMain.Range("A1", Rng).Copy
        sh.Range("A1").PasteSpecial xlPasteColumnWidths
        sh.Range("A1").PasteSpecial xlPasteValues
        sh.Range("A1").PasteSpecial xlPasteFormats
        ActiveWorkbook.Close True, ThisWorkbook.Path & "\" & sh.Name & ".xlsx"
    End With
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[phulien1902]

Bạn thử sửa lại như thế này xem sao

Sub tachsheet()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim ShMain As Worksheet, Rng As Range, sh As Worksheet
   
For Each ShMain In Worksheets
    Set Rng = ShMain.Range("A1").CurrentRegion
    With Workbooks.Add
        Set sh = .Sheets(1)
        sh.Name = ShMain.Name
        ShMain.Range("A1", Rng).Copy
        sh.Range("A1").PasteSpecial xlPasteColumnWidths
        sh.Range("A1").PasteSpecial xlPasteValues
        sh.Range("A1").PasteSpecial xlPasteFormats
        ActiveWorkbook.Close True, ThisWorkbook.Path & "\" & sh.Name & ".xlsx"
    End With
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Theo ý kiến của tôi thì thay:

.Range("A1").CurrentRegion

bằng:

.UsedRange

sẽ có ứng dụng tổng quát hơn

 

[dungnh1501]

tks các bạn mình làm được rồi

 

[dungnh1501]

Bạn thử sửa lại như thế này xem sao

Sub tachsheet()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim ShMain As Worksheet, Rng As Range, sh As Worksheet
   
For Each ShMain In Worksheets
    Set Rng = ShMain.Range("A1").CurrentRegion
    With Workbooks.Add
        Set sh = .Sheets(1)
        sh.Name = ShMain.Name
        ShMain.Range("A1", Rng).Copy
        sh.Range("A1").PasteSpecial xlPasteColumnWidths
        sh.Range("A1").PasteSpecial xlPasteValues
        sh.Range("A1").PasteSpecial xlPasteFormats
        ActiveWorkbook.Close True, ThisWorkbook.Path & "\" & sh.Name & ".xlsx"
    End With
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Bạn ơi, có cách nào không copy phần đã bị hide không nhỉ

 

[PacificPR]

bạn thử thay dong này
ShMain.Range("A1", Rng).Copy thành ShMain.Range("A1", Rng).SpecialCells(12).Copy thử xem sao

 

[HieuCD]

một cách copy gán giá trị

Sub tachsheet()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim sh As Worksheet
For Each sh In Worksheets
    sh.Copy
    ActiveWorkbook.SaveAs ThisWorkbook.Path & "\" & sh.Name, 51
    ActiveSheet.UsedRange.Value = ActiveSheet.UsedRange.Value
  ActiveWorkbook.Close
Next
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[Lê Duy Thương]

Mình đang muốn tách cách sheet trong 1 file excel ra thành cách file excel mới, nhưng khi tách ra thì nó ăn cả công thức của sheet cũ (trong sheet cũ có filter). Mình muốn copy chỉ lấy ra phần dữ liệu đang hiển thị, hoặc protect không cho chỉnh sửa trên file excel mới đó. mọi người giúp mình với

Thay sh.Copy thành
Sh.Cells.Copy
Workbooks.Add
Sheet1.Range("A1").PasteSpecial (12) thử xem