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

huevantran · 14/9/23

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

hvnhpro · 14/9/23

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

befaint · 14/9/23

Em úp file đó lên đây.

huevantran · 14/9/23

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

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.

Em gửi 1 file giả lập đơn giản lên, nhờ anh xem giúp em với ạ.

befaint · 14/9/23

huevantran đã viết:
xem giúp

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

huevantran · 14/9/23

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

Cảm ơn anh rất nhiều, em làm được rồi ạ.

Văn Toàn 1996 · 14/9/23

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

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

huevantran · 17/9/23

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

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 ạ.

BuiQuangThuan · 17/9/23

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 294890 View attachment 294892

Bạn dịch đoạn tiếng anh kia ra tiếng Việt là có kết quả liền à

huevantran · 17/9/23

BuiQuangThuan đã viết:
Bạn dịch đoạn tiếng anh kia ra tiếng Việt là có kết quả liền à

Em có hiểu đoạn đó viết nội dung là gì anh, tuy nhiên khi đóng tất cả ứng dụng, chỉ chạy dữ liệu giả lập nhưng vẫn bị báo lỗi không đủ bộ nhớ anh ạ.

befaint · 17/9/23

@Thớt: Em khởi động lại máy tính nhé.

huevantran · 18/9/23

befaint đã viết:
@Thớt: Em khởi động lại máy tính nhé.

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.

hvnhpro · 18/9/23

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ớ.

huevantran · 18/9/23

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ớ.

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.

befaint · 18/9/23

huevantran đã viết:
hỏi anh thêm chú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

huevantran · 19/9/23

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

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ớ.

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.

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

huevantran

Thành viên chính thức

hvnhpro

Thành viên hoạt động

befaint

|||||||||||||

huevantran

Thành viên chính thức

File đính kèm

befaint

|||||||||||||

huevantran

Thành viên chính thức

Văn Toàn 1996

Thành viên hoạt động

huevantran

Thành viên chính thức

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

huevantran

Thành viên chính thức

befaint

|||||||||||||

huevantran

Thành viên chính thức

hvnhpro

Thành viên hoạt động

huevantran

Thành viên chính thức

befaint

|||||||||||||

huevantran

Thành viên chính thức

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

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