VBA - copy các sheets unhide và dạng giá trị theo vùng xác định (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Tôi tuân thủ nội quy khi đăng bài

nguyenhuong91

Thành viên mới
Tham gia
19/10/11
Bài viết
6
Được thích
0
Dạ em chào anh chị ạ!

Em đang tận dụng VBA để export 1 file có đặc điểm sau:
- Có rất nhiều sheets
- Sheet nào cũng có công thức

Nhu cầu export 1 file gửi cho khách hàng:
1. Chỉ xuất các sheets hiển thị
2. Thông tin trong các sheets hiện thị:
> Copy paste value: các line từ 1-30 (chỉ copy giá trị ạ)
> Copy paste: Các line từ 30 trở đi (giữ nguyên công thức)

Với nhu cầu (1), em đang dùng code dưới nhưng các sheet được xuất vẫn giữ nguyên công thức => Nếu các sheets được xuất có công thức phụ thuộc vào sheets hide thì giá trị bị lỗi ạ.

Sub Export()
Dim ws As Worksheet

With CreateObject("scripting.dictionary")
For Each ws In Worksheets
If ws.Visible = xlSheetVisible Then .Add ws.Name, Nothing
Next ws
Sheets(.Keys).Copy
End With
ActiveWorkbook.SaveAs ThisWorkbook.Path & Application.PathSeparator & "Customer.xlsm", 52
End Sub

Em xin phép gửi các anh chị cao nhân file mô phỏng đính kèm để các anh chị dễ hình dung ạ.
Mong các anh chị chỉ em với ạ.
Em cám ơn anh chị nhiều ạ. <3
 

File đính kèm

Em xin phép gửi các anh chị cao nhân file mô phỏng đính kèm để các anh chị dễ hình dung ạ.
Bạn nên đưa code của mình vào thẻ code cho dễ nhìn
Thêm nữa với code hiện tại thì nó đã làm được những gì? Vấn đề bạn đang gặp phải là như nào? Có thể đính kèm thêm hình ảnh hay gì đó để nhìn thấy không?
Hãy mô tả thêm 1 chút nữa coi xem giúp được gì không nào?
Và không viết tắt, tây ta lẫn lộn, nên dùng những từ ngữ phổ thông chuẩn mực. Ví dụ: không phải "Cao nhân" thì không được tham gia sao?
 
Lần chỉnh sửa cuối:
Upvote 0
Thử code này nhé bạn:
PHP:
Option Explicit
Sub ExportB()
Dim ws As Worksheet
Dim dic As Object, key
Set dic = CreateObject("Scripting.Dictionary")
For Each ws In Sheets
    If ws.Visible = xlSheetVisible Then dic.Add ws.Name, ""
Next
Sheets(dic.keys).Copy
With ActiveWorkbook
    For Each ws In .Sheets
        With ws.Rows("1:30")
            .Copy
            .PasteSpecial Paste:=xlPasteValues
        End With
    Next
    .SaveAs ThisWorkbook.Path & Application.PathSeparator & "For send to site.xlsm", 52
End With
End Sub
 
Upvote 0
Theo mình chỗ này không cần dùng dictionary làm gì vì tên Sheets là duy nhất rồi.
Bạn tham khảo thử code sau:

PHP:
Sub Export()
    Dim ws As Worksheet
    Dim newWorkbook As Workbook
    Dim newSheet As Worksheet
    Dim lastRow As Long
    Dim i As Integer
    Dim cell As Range
  
    Application.ScreenUpdating = False

    Set newWorkbook = Workbooks.Add
    newWorkbook.Sheets(newWorkbook.Sheets.Count).Name = "XXXX_XOAXOAXOA"
  
    For Each ws In ThisWorkbook.Worksheets
        If ws.Visible = xlSheetVisible Then
            ws.Copy After:=newWorkbook.Sheets(newWorkbook.Sheets.Count)
            Set newSheet = newWorkbook.Sheets(ws.Name)
            lastRow = newSheet.Cells(ws.Rows.Count, 1).End(xlUp).Row
            For i = 1 To 30
                For Each cell In newSheet.Rows(i).Cells
                    If cell.HasFormula Then
                        cell.Value = cell.Value
                    End If
                Next cell
            Next i
        End If
    Next ws
  
    Application.DisplayAlerts = False
    newWorkbook.Sheets("XXXX_XOAXOAXOA").Delete
    Application.DisplayAlerts = True
  
    newWorkbook.SaveAs ThisWorkbook.Path & Application.PathSeparator & "Customer_Export_" & Format(Now(), "yyyy_mm_dd_hh_mm_ss") & ".xlsm", 52
    newWorkbook.Close False
    Application.ScreenUpdating = True
End Sub
Và nếu không dùng code thì nên lưu thành xlsx luôn nhỉ ?
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn nên đưa code của mình vào thẻ code cho dễ nhìn
Thêm nữa với code hiện tại thì nó đã làm được những gì? Vấn đề bạn đang gặp phải là như nào? Có thể đính kèm thêm hình ảnh hay gì đó để nhìn thấy không?
Hãy mô tả thêm 1 chút nữa coi xem giúp được gì không nào?
Và không viết tắt, tây ta lẫn lộn, nên dùng những từ ngữ phổ thông chuẩn mực. Ví dụ: không phải "Cao nhân" thì không được tham gia sao?
Dạ em rất lưu ý các lần sau ạ. Em cám ơn anh đã nhắc nhở ạ!
 
Upvote 0
Thử code này nhé bạn:
PHP:
Option Explicit
Sub ExportB()
Dim ws As Worksheet
Dim dic As Object, key
Set dic = CreateObject("Scripting.Dictionary")
For Each ws In Sheets
    If ws.Visible = xlSheetVisible Then dic.Add ws.Name, ""
Next
Sheets(dic.keys).Copy
With ActiveWorkbook
    For Each ws In .Sheets
        With ws.Rows("1:30")
            .Copy
            .PasteSpecial Paste:=xlPasteValues
        End With
    Next
    .SaveAs ThisWorkbook.Path & Application.PathSeparator & "Customer.xlsm", 52
End With
End Sub
Dạ, em cám ơn bác rất nhiều ạ! hiện em áp dụng thấy thành công rồi ạ.
 
Upvote 0
Hiện em có thử các code trên và có đang gặp kết quả sau:
Các khu vực giữ nguyên công thức, khi xuất sang file khác, địa chỉ file thể hiện như sau ạ.

VD: Copy dữ liệu từ file: ABCD.xlsm sang file khác thì công thức thể hiện: =MAX('C:\Users\ABCD.xlsm]Summary'!$K$5:$K$14).

Nhờ các anh chị có thể chỉ giúp em có cách nào để:
1. Khi copy thì sẽ không có địa chỉ trang, chỉ có công thức thôi ạ
2. Nếu trong TH mà copy range (các dòng từ 1-30, các cột từ A-Z) thì code nên em nên thay đổi như thế nào cho phù hợp ạ?

Em cám ơn các anh chị nhiều ạ!
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom