VBA - Xuất file excel dạng values: Copy, Paste Values dữ liệu tự động từng sheets và xóa cột, hàng ẩn tự động

Quảng cáo

TanNguyen23

Thành viên mới
Tham gia ngày
6 Tháng hai 2020
Bài viết
4
Được thích
0
Điểm
0
Xin chào cộng đồng GPE,
Mình thường xuyên phải xuất dữ liệu thành kiểu paste values (để xóa công thức đi, nếu có), sau đó xóa các hàng, cột ẩn đi và tất cả đều phải làm thủ công nên rất mất thời gian vì nhiều sheets và nhiều cột, hàng
Mình đang làm một cái code để đơn giản công việc lại, Vì mới tìm hiểu, kiến thức hạn hẹp nên thỉnh cầu cộng đồng GPE giúp đỡ ạ
Công việc:
1 - Trong mỗi sheet: Copy dữ liệu trong sheet, Paste dữ liệu theo kiểu giá trị (Paste Values) ngay tại sheet đó
2 - Xóa các cột, hàng đang ẩn trong sheet vừa copy
Sang sheet tiếp theo, thực hiện cho đến hết các sheet có trong file (lặp lại các bước đó cho các sheet khác)

Đây là code mình đã viết nhưng đang bị bí:
VBAExport.PNG

Mình đính kèm file mẫu mình đang làm bên dưới luôn ạ.
Mình cảm ơn rất nhiều ạ
 

File đính kèm

  • ki-2020-country-tables.xlsm
    376.6 KB · Đọc: 20

Maika8008

Thành viên tích cực
Tham gia ngày
12 Tháng sáu 2020
Bài viết
920
Được thích
727
Điểm
268
Xin chào cộng đồng GPE,
Mình thường xuyên phải xuất dữ liệu thành kiểu paste values (để xóa công thức đi, nếu có), sau đó xóa các hàng, cột ẩn đi và tất cả đều phải làm thủ công nên rất mất thời gian vì nhiều sheets và nhiều cột, hàng
Mình đang làm một cái code để đơn giản công việc lại, Vì mới tìm hiểu, kiến thức hạn hẹp nên thỉnh cầu cộng đồng GPE giúp đỡ ạ
Công việc:
1 - Trong mỗi sheet: Copy dữ liệu trong sheet, Paste dữ liệu theo kiểu giá trị (Paste Values) ngay tại sheet đó
2 - Xóa các cột, hàng đang ẩn trong sheet vừa copy
Sang sheet tiếp theo, thực hiện cho đến hết các sheet có trong file (lặp lại các bước đó cho các sheet khác)

Đây là code mình đã viết nhưng đang bị bí:
View attachment 250120
Mình đính kèm file mẫu mình đang làm bên dưới luôn ạ.
Mình cảm ơn rất nhiều ạ
Code bạn không vô hiệu hóa cập nhật màn hình và các sự kiện nên chạy rất lâu đồng thời có 1 chỗ sai cơ bản, đó là thay vì dùng Columns(j).EntireColumn.Delete thì bạn dùng Columns(j).EntireRow.Delete

Bạn dùng code tôi viết lại:
Rich (BB code):
Sub Fix_ExportData()

Dim ws As Object
Dim L_R As Long, L_C As Long
Dim i, j As Integer
Dim mySheet As Worksheet
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
    For Each mySheet In Worksheets
    
        L_R = Cells.SpecialCells(xlCellTypeLastCell).Row
        L_C = Cells.SpecialCells(xlCellTypeLastCell).Column
        Range("A1", Cells(L_R, L_C)).Copy
        Range("A1", Cells(L_R, L_C)).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        For i = L_R To 1 Step -1
        If Rows(i).Hidden Then Rows(i).EntireRow.Delete
        Next
        
        For j = L_C To 1 Step -1
        If Columns(j).Hidden Then Columns(j).EntireColumn.Delete  
        Next
    
    Next
    
    Application.DisplayAlerts = False

'Chỗ này sao bạn lại dùng ws.Application.ActiveDocument.SaveAs nhỉ, nó có chạy được đâu
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator _
    & "FILE_EXCEL" & Format(Now, "yyyymmdd") & "_DATA" & ".xlsm"

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

End Sub
 

TanNguyen23

Thành viên mới
Tham gia ngày
6 Tháng hai 2020
Bài viết
4
Được thích
0
Điểm
0
Code bạn không vô hiệu hóa cập nhật màn hình và các sự kiện nên chạy rất lâu đồng thời có 1 chỗ sai cơ bản, đó là thay vì dùng Columns(j).EntireColumn.Delete thì bạn dùng Columns(j).EntireRow.Delete

Bạn dùng code tôi viết lại:
Rich (BB code):
Sub Fix_ExportData()

Dim ws As Object
Dim L_R As Long, L_C As Long
Dim i, j As Integer
Dim mySheet As Worksheet
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
   
    For Each mySheet In Worksheets
   
        L_R = Cells.SpecialCells(xlCellTypeLastCell).Row
        L_C = Cells.SpecialCells(xlCellTypeLastCell).Column
        Range("A1", Cells(L_R, L_C)).Copy
        Range("A1", Cells(L_R, L_C)).PasteSpecial Paste:=xlPasteValues
        Application.CutCopyMode = False
        For i = L_R To 1 Step -1
        If Rows(i).Hidden Then Rows(i).EntireRow.Delete
        Next
       
        For j = L_C To 1 Step -1
        If Columns(j).Hidden Then Columns(j).EntireColumn.Delete 
        Next
   
    Next
   
    Application.DisplayAlerts = False

'Chỗ này sao bạn lại dùng ws.Application.ActiveDocument.SaveAs nhỉ, nó có chạy được đâu
    ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator _
    & "FILE_EXCEL" & Format(Now, "yyyymmdd") & "_DATA" & ".xlsm"

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True

End Sub
Cảm ơn bạn nhiều vì đã giúp đỡ. Do mình là newbie á bạn, mình cũng lượm chỗ này lắp chỗ kia thôi, có nhiều lệnh mình cũng chưa hiểu lắm :V
 
Quảng cáo
Top Bottom