Xin tư vấn code copy 1 file đuôi .xlsm, chỉnh sửa và lưu thành 1 file mới đuôi .xlsx (1 người xem)

Elx Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Tôi tuân thủ nội quy khi đăng bài
Có
huevantran

huevantran

Thành viên chính thức
Tham gia
27/4/22
Bài viết
55
Được thích
42
Em chào tất cả mọi người,

Em có 1 file làm việc, có sheet DATA chứa dữ liệu tập trung, và có các sheet còn lại chứa các biểu mẫu đã có sẵn các công thức để điền dữ liệu từ sheet DATA vào.
Em đang tìm cách viết 1 code Copy File Gốc (Đuôi .xlsm) thành 1 file mới, trong file mới em muốn xóa bỏ công thức 1 số vùng, đặt lại tên file, và lưu dưới dạng .xlsx.
Lý do file gốc em phải lưu dưới dạng .xlsm vì trong file có chứa code VBA, còn file mới copy ra em muốn lưu .xlsx để xóa bỏ code vba trước khi gửi cho người khác.
Mã code của em bên dưới, hiện tại em chỉ có thể copy file mới giống định dạng file gốc là dạng đuôi .xlsm, nếu đổi sang .xlsx sẽ bị lỗi.
Nhờ các anh/chị xem và hướng dẫn em cách chuyển file mới thành .xlsx được không ạ. Em cảm ơn.

Mã: 
Sub Copy()
    Application.DisplayAlerts = False
    Dim FileGoc As Workbook
    Dim FileMoi As Workbook
    Dim Duong_dan As String
    Dim Ten_File As String
    Duong_dan = ThisWorkbook.Path & "\"
    Set FileGoc = ThisWorkbook
    Ten_File = FileGoc.Sheets("DATA").Range("B1").Value
    FileGoc.SaveCopyAs Duong_dan & Ten_File & ".xlsm"
    Set FileMoi = Workbooks.Open(Duong_dan & Ten_File & ".xlsm")
    FileMoi.Sheets("DS").Range("A11:G19").Value = FileMoi.Sheets("DS").Range("A11:G19").Value
    FileMoi.Sheets("DS").Range("N11:U19").Value = FileMoi.Sheets("DS").Range("N11:U19").Value
    FileMoi.Sheets("DATA").Delete
    FileMoi.Close SaveChanges:=True
    Application.DisplayAlerts = True
End Sub
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Mình đang làm theo phương án sau:
-Move_Copy sheet chứa báo cáo cần gửi sang workbook mới xong
-Lưu file dưới dạng xlsx
-remove link file mới với file cũ.

không biết có đúng yêu cầu của bạn không
 
Upvote 0
hvnhpro đã viết:
Mình đang làm theo phương án sau:
-Move_Copy sheet chứa báo cáo cần gửi sang workbook mới xong
-Lưu file dưới dạng xlsx
-remove link file mới với file cũ.

không biết có đúng yêu cầu của bạn không
Nhấp chuột vào đây để mở rộng...
File của em có nhiều sheet chứa công thức anh ạ, em chỉ cần xóa sheet data khỏi file gửi đi là được nên em mới thử Copy nguyên cả file gốc. Nếu cách của em không làm được em sẽ thử theo cách anh chỉ xem sao.

befaint đã viết:
Em úp file đó lên đây.
Nhấp chuột vào đây để mở rộng...
Em gửi 1 file giả lập đơn giản lên, nhờ anh xem giúp em với ạ.
 

File đính kèm

Upvote 0
huevantran đã viết:
xem giúp
Nhấp chuột vào đây để mở rộng...

Em xem mi ni súp này nhé

PHP: 
Sub miniCopy()
    Application.DisplayAlerts = False
    Dim FileGoc As Workbook, strPathFileGoc As String
    Dim FileMoi As Workbook
    Dim Duong_dan As String
    Dim Ten_File As String
 
    strPathFileGoc = ThisWorkbook.FullName
    Duong_dan = ThisWorkbook.Path & "\" '"
    Set FileGoc = ThisWorkbook
    Ten_File = FileGoc.Sheets("DATA").Range("B1").Value
    FileGoc.SaveAs Filename:=Duong_dan & Ten_File & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    Set FileMoi = Workbooks.Open(Duong_dan & Ten_File & ".xlsx")
    FileMoi.Sheets("DS").Range("A11:G19").Value = FileMoi.Sheets("DS").Range("A11:G19").Value
    FileMoi.Sheets("DS").Range("N11:U19").Value = FileMoi.Sheets("DS").Range("N11:U19").Value
    On Error Resume Next
    FileMoi.Sheets("DATA").Delete
    On Error GoTo 0
    Call Workbooks.Open(strPathFileGoc)
    FileMoi.Close SaveChanges:=True
    Application.DisplayAlerts = True
End Sub
 
Upvote 0
befaint đã viết:
Em xem mi ni súp này nhé

PHP: 
Sub miniCopy()
    Application.DisplayAlerts = False
    Dim FileGoc As Workbook, strPathFileGoc As String
    Dim FileMoi As Workbook
    Dim Duong_dan As String
    Dim Ten_File As String
 
    strPathFileGoc = ThisWorkbook.FullName
    Duong_dan = ThisWorkbook.Path & "\" '"
    Set FileGoc = ThisWorkbook
    Ten_File = FileGoc.Sheets("DATA").Range("B1").Value
    FileGoc.SaveAs Filename:=Duong_dan & Ten_File & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    Set FileMoi = Workbooks.Open(Duong_dan & Ten_File & ".xlsx")
    FileMoi.Sheets("DS").Range("A11:G19").Value = FileMoi.Sheets("DS").Range("A11:G19").Value
    FileMoi.Sheets("DS").Range("N11:U19").Value = FileMoi.Sheets("DS").Range("N11:U19").Value
    On Error Resume Next
    FileMoi.Sheets("DATA").Delete
    On Error GoTo 0
    Call Workbooks.Open(strPathFileGoc)
    FileMoi.Close SaveChanges:=True
    Application.DisplayAlerts = True
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn anh rất nhiều, em làm được rồi ạ.
 
Upvote 0
huevantran đã viết:
Em chào tất cả mọi người,

Em có 1 file làm việc, có sheet DATA chứa dữ liệu tập trung, và có các sheet còn lại chứa các biểu mẫu đã có sẵn các công thức để điền dữ liệu từ sheet DATA vào.
Em đang tìm cách viết 1 code Copy File Gốc (Đuôi .xlsm) thành 1 file mới, trong file mới em muốn xóa bỏ công thức 1 số vùng, đặt lại tên file, và lưu dưới dạng .xlsx.
Lý do file gốc em phải lưu dưới dạng .xlsm vì trong file có chứa code VBA, còn file mới copy ra em muốn lưu .xlsx để xóa bỏ code vba trước khi gửi cho người khác.
Mã code của em bên dưới, hiện tại em chỉ có thể copy file mới giống định dạng file gốc là dạng đuôi .xlsm, nếu đổi sang .xlsx sẽ bị lỗi.
Nhờ các anh/chị xem và hướng dẫn em cách chuyển file mới thành .xlsx được không ạ. Em cảm ơn.

Mã: 
Sub Copy()
    Application.DisplayAlerts = False
    Dim FileGoc As Workbook
    Dim FileMoi As Workbook
    Dim Duong_dan As String
    Dim Ten_File As String
    Duong_dan = ThisWorkbook.Path & "\"
    Set FileGoc = ThisWorkbook
    Ten_File = FileGoc.Sheets("DATA").Range("B1").Value
    FileGoc.SaveCopyAs Duong_dan & Ten_File & ".xlsm"
    Set FileMoi = Workbooks.Open(Duong_dan & Ten_File & ".xlsm")
    FileMoi.Sheets("DS").Range("A11:G19").Value = FileMoi.Sheets("DS").Range("A11:G19").Value
    FileMoi.Sheets("DS").Range("N11:U19").Value = FileMoi.Sheets("DS").Range("N11:U19").Value
    FileMoi.Sheets("DATA").Delete
    FileMoi.Close SaveChanges:=True
    Application.DisplayAlerts = True
End Sub
Nhấp chuột vào đây để mở rộng...

Bạn thử code này

Mã: 
Sub CopyAndSaveAsXLSX()
    Dim wbSource As Workbook
    Dim wbNew As Workbook
    
    ' Mở tệp .xlsm nguồn
    Set wbSource = Workbooks.Open("Đường_dẫn_tệp.xlsm")
    
    ' Tạo một bản sao của tệp .xlsm
    wbSource.SaveCopyAs "Đường_dẫn_để_lưu_một_bản_sao.xlsm" ' Lưu thành một tệp .xlsx
    
    ' Đảm bảo rằng đã tạo ra một bản sao ưu tiên nếu có
    Application.DisplayAlerts = False
    
    ' Mở tệp .xlsx
    Set wbNew = Workbooks.Open("Đường_dẫn_tệp.xlsm")
    
    ' Thực hiện các chỉnh sửa cần thiết ở đây nếu có
    
    ' Lưu lại tệp .xlsx
    wbNew.SaveAs "Đường_dẫn_tệp.xlsx", FileFormat:=xlOpenXMLWorkbook
    
    ' Đóng các tệp
    wbSource.Close SaveChanges:=False
    wbNew.Close SaveChanges:=False
  
    ' Bật cảnh báo trở lại
    Application.DisplayAlerts = True
End Sub
 
Upvote 0
befaint đã viết:
Em xem mi ni súp này nhé

PHP: 
Sub miniCopy()
    Application.DisplayAlerts = False
    Dim FileGoc As Workbook, strPathFileGoc As String
    Dim FileMoi As Workbook
    Dim Duong_dan As String
    Dim Ten_File As String
 
    strPathFileGoc = ThisWorkbook.FullName
    Duong_dan = ThisWorkbook.Path & "\" '"
    Set FileGoc = ThisWorkbook
    Ten_File = FileGoc.Sheets("DATA").Range("B1").Value
    FileGoc.SaveAs Filename:=Duong_dan & Ten_File & ".xlsx", FileFormat:=xlOpenXMLWorkbook
    Set FileMoi = Workbooks.Open(Duong_dan & Ten_File & ".xlsx")
    FileMoi.Sheets("DS").Range("A11:G19").Value = FileMoi.Sheets("DS").Range("A11:G19").Value
    FileMoi.Sheets("DS").Range("N11:U19").Value = FileMoi.Sheets("DS").Range("N11:U19").Value
    On Error Resume Next
    FileMoi.Sheets("DATA").Delete
    On Error GoTo 0
    Call Workbooks.Open(strPathFileGoc)
    FileMoi.Close SaveChanges:=True
    Application.DisplayAlerts = True
End Sub
Nhấp chuột vào đây để mở rộng...
Em chào anh,
Cho em hỏi anh thêm chút với nha, với mã code này thì khi chạy trên bản Excel 2021 thì cho kết quả đúng, tuy nhiên khi em chạy trên máy tính cá nhân ở nhà sử dụng Excel 2016 thì báo lỗi, em có kiểm tra thì máy em đang dùng đã là bản Excel 64 bit. Đóng hết tất cả các ứng dụng và chạy dữ liệu giả lập nhưng vẫn báo lỗi, nhờ anh xem giúp em nguyên nhân là gì với ạ.
1694917712772.png1694917745080.png
 
Upvote 0
huevantran đã viết:
Em chào anh,
Cho em hỏi anh thêm chút với nha, với mã code này thì khi chạy trên bản Excel 2021 thì cho kết quả đúng, tuy nhiên khi em chạy trên máy tính cá nhân ở nhà sử dụng Excel 2016 thì báo lỗi, em có kiểm tra thì máy em đang dùng đã là bản Excel 64 bit. Đóng hết tất cả các ứng dụng và chạy dữ liệu giả lập nhưng vẫn báo lỗi, nhờ anh xem giúp em nguyên nhân là gì với ạ.
View attachment 294890View attachment 294892
Nhấp chuột vào đây để mở rộng...
Bạn dịch đoạn tiếng anh kia ra tiếng Việt là có kết quả liền à
 
Upvote 0
befaint đã viết:
@Thớt: Em khởi động lại máy tính nhé.
Nhấp chuột vào đây để mở rộng...
Em đã thử nhưng cũng không được anh ạ, em có mượn máy 1 bạn khác chạy thử trên bản Excel 2013 thì cũng báo lỗi như em. Nguyên nhân có phải do cách thức mở và lưu file xlsx giữa các phiên bản Excel là khác nhau phải không anh.
 
Upvote 0
Thực tế file mình làm việc thì việc copy paste value cũng từng lỗi như bạn. (Do file mình chưa nhiều dòng dữ liệu ~ 200k dòng, nhiều công thức sumifs, vlookup).

Nếu file bạn làm không đơn giản chỉ có 2 vùng paste value trên thì bạn thử cách mình gửi ý ở bài viết #2 trên xem sao, cách này mình thấy hạn chế việc tính toán lại khi lưu file xlsx nên không bị lỗi không đủ bộ nhớ.
 
Upvote 0
hvnhpro đã viết:
Thực tế file mình làm việc thì việc copy paste value cũng từng lỗi như bạn. (Do file mình chưa nhiều dòng dữ liệu ~ 200k dòng, nhiều công thức sumifs, vlookup).

Nếu file bạn làm không đơn giản chỉ có 2 vùng paste value trên thì bạn thử cách mình gửi ý ở bài viết #2 trên xem sao, cách này mình thấy hạn chế việc tính toán lại khi lưu file xlsx nên không bị lỗi không đủ bộ nhớ.
Nhấp chuột vào đây để mở rộng...
Dữ liệu của em ít thôi anh ạ. Nếu vậy em sẽ thử làm theo hướng của anh xem sao. Cảm ơn anh.
 
Upvote 0
befaint đã viết:
Em chỉnh 2 dòng này nhé.

PHP: 
    FileMoi.Sheets("DS").Range("A11:G19").Value = FileMoi.Sheets("DS").Range("A11:G19").Value2
    FileMoi.Sheets("DS").Range("N11:U19").Value = FileMoi.Sheets("DS").Range("N11:U19").Value2
Nhấp chuột vào đây để mở rộng...
Em đã thử những vẫn không được anh ạ.

hvnhpro đã viết:
Thực tế file mình làm việc thì việc copy paste value cũng từng lỗi như bạn. (Do file mình chưa nhiều dòng dữ liệu ~ 200k dòng, nhiều công thức sumifs, vlookup).

Nếu file bạn làm không đơn giản chỉ có 2 vùng paste value trên thì bạn thử cách mình gửi ý ở bài viết #2 trên xem sao, cách này mình thấy hạn chế việc tính toán lại khi lưu file xlsx nên không bị lỗi không đủ bộ nhớ.
Nhấp chuột vào đây để mở rộng...
Em đã làm theo cách của anh và đã giải được vấn đề của mình, file chạy cũng nhanh hơn, dễ tùy biến hơn. Cảm ơn anh đã chỉ dẫn.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

C
Fix lỗi Application.InputBox Type:=8 (4 người xem)
    • Cười
Trả lời
3
Đọc
29
cdshtz88
C
E
  • Question Question
VBA tự động thay đổi tham chiếu vùng (range và cell) khi insert dòng cột trong sheet tính toán
    • Cười
Trả lời
5
Đọc
102
eagle12
E
L
Hỏi lỗi excel bị tràn trang khi in
Trả lời
1
Đọc
47
Hoàng Tuấn 868
H
D
Tổng hợp dữ liệu từ các sheet sang sheet tổng (1 người xem)
Trả lời
3
Đọc
129
dohungmo
D
T
font chu trong excel
Trả lời
2
Đọc
61
Hoàng Tuấn 868
H
khuong182018
  • Question Question
Nhờ anh chị sửa lỗi setfocus ở textbox
Trả lời
9
Đọc
156
khuong182018
khuong182018
N
File chia băng tự động từ cuộn mẹ theo khổ băng và khối lượng băng cho trước
Trả lời
0
Đọc
35
nguyenanhtruong2409
N
Emyeuexcel
Tham chiếu về 1 ô-lấy ra và lọc dữ liệu
Trả lời
2
Đọc
53
bigbabol89
bigbabol89
SA_DQ
Copilot bình luận về một ván cờ vua
Trả lời
0
Đọc
64
SA_DQ
SA_DQ
T
Xin giúp đỡ lọc dữ liệu
    • Cười
Trả lời
4
Đọc
106
pycckuu410
pycckuu410
Nguyễn Duy Tuân
[New] BSAC v3.0 bộ công cụ lập trình phần mềm chuyên nghiệp trong VBA
    • Thích
Trả lời
13
Đọc
4K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
H
  • Question Question
Code Sổ Chi Tiết Tài Khoản
Trả lời
8
Đọc
316
hieuvietmy2020
H
befaint
Chia sẻ tâm tư, xả nỗi lòng (2 người xem)
    • Thích
6 7 8
Trả lời
778
Đọc
74K
SA_DQ
SA_DQ
H
Chia sẻ file in Phiếu điều tra PCGD
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
12
Đọc
435
HUONGHCKT
H
V
Hỏi công thức để làm khối lượng trong xây dựng. Xin cảm ơn
Trả lời
11
Đọc
512
phanphu_91
P
Linhnv0001
Hỏi - Cách kiểm tra laptop là hàng lắp ráp hay không (1 người xem)
Trả lời
3
Đọc
268
Lê Duy Thương
Lê Duy Thương
K
Nhờ anh chị làm công thức lọc dữ kiện ngày từ bảng 1 sang rút gọn ngày ở bảng 2.
Trả lời
2
Đọc
180
Lê Duy Thương
Lê Duy Thương
L
[Mẹo] Không chọn Add-in vẫn có thể sử dụng được chức năng của Add-in, giảm tốc độ loading của Excel.
    • Thích
Trả lời
2
Đọc
484
HeSanbi
HeSanbi
GPE-Trợ Lý
[GPE18] KỸ THUẬT BIỂU ĐỒ NÂNG CAO CHO DASHBOARD: TRỰC QUAN HÓA TIẾN ĐỘ THỰC HIỆN KẾ HOẠCH
    • Thích
Trả lời
2
Đọc
9K
ptm0412
ptm0412
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (4 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
4 5 6
Trả lời
553
Đọc
72K
anh.nguyen287
anh.nguyen287
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom