Copy & paste value bằng VBA (1 người xem)

[PAT_excel]

Chào các bạn,
Mình có 1 sheet (file đính kèm), trong đó có cả các button để thực hiện các công việc khác nhau. Các bạn giúp mình:
khi nhấn nút "copy mẫu này sang file mới" sẽ thực hiện việc Copy sheet hiện thời sang 1 file khác nhưng không copy các button sang file mới.
cảm ơn các bạn nhiều.

 

[LamNA]

Chào các bạn,
Mình có 1 sheet (file đính kèm), trong đó có cả các button để thực hiện các công việc khác nhau. Các bạn giúp mình:
khi nhấn nút "copy mẫu này sang file mới" sẽ thực hiện việc Copy sheet hiện thời sang 1 file khác nhưng không copy các button sang file mới.
cảm ơn các bạn nhiều.

Anh thử

Sub XuatFile()
Dim shp As Shape
   With Application
        .ScreenUpdating = False
            Sheets("DNS39c").Copy
            ActiveSheet.Name = "DNS39c"
            For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp
            ActiveWorkbook.Close True, ThisWorkbook.Path & "\DNS39c_" & Format(Now(), "dd-mm-yyyy")
        .ScreenUpdating = True
    End With
End Sub

 

[PAT_excel]

Anh thử

Sub XuatFile()
Dim shp As Shape
   With Application
        .ScreenUpdating = False
            Sheets("DNS39c").Copy
            ActiveSheet.Name = "DNS39c"
            For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp
            ActiveWorkbook.Close True, ThisWorkbook.Path & "\DNS39c_" & Format(Now(), "dd-mm-yyyy")
        .ScreenUpdating = True
    End With
End Sub

Cảm ơn LamBA, bạn sửa giúp mình 1 chút nữa nhé.
1. code này chạy được cho tất cả các Active sheet
2. Cho người dùng chọn được đường dẫn để lưu và tự đặt tên file

 

[LamNA]

Cảm ơn LamBA, bạn sửa giúp mình 1 chút nữa nhé.
1. code này chạy được cho tất cả các Active sheet
2. Cho người dùng chọn được đường dẫn để lưu và tự đặt tên file

Anh chỉnh lại code này

Sub XuatFile()
Dim shp As Shape
Application.ScreenUpdating = False
On Error GoTo ExitSub
ActiveSheet.Copy
For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp
With Application.FileDialog(2)
.Show: .AllowMultiSelect = False
ActiveWorkbook.SaveAs .SelectedItems(1)
End With
ExitSub:
ActiveWorkbook.Close (False)
Application.ScreenUpdating = True
End Sub

 

[PAT_excel]

Anh chỉnh lại code này

Sub XuatFile()
Dim shp As Shape
Application.ScreenUpdating = False
On Error GoTo ExitSub
ActiveSheet.Copy
For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp
With Application.FileDialog(2)
.Show: .AllowMultiSelect = False
ActiveWorkbook.SaveAs .SelectedItems(1)
End With
ExitSub:
ActiveWorkbook.Close (False)
Application.ScreenUpdating = True
End Sub

Cảm ơn bạn. Code chạy vẫn bị 1 lỗi là khi lưu file đè lên file đã có sẵn thì bị 2 lần thông báo "file đã có, có ghi đè lên không?". Bạn sửa giúp mình nhé.

 

[LamNA]

Cảm ơn bạn. Code chạy vẫn bị 1 lỗi là khi lưu file đè lên file đã có sẵn thì bị 2 lần thông báo "file đã có, có ghi đè lên không?". Bạn sửa giúp mình nhé.

Anh sửa lại code như sau giúp em nhe

Sub XuatFile()
Dim shp As Shape
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo ExitSub
ActiveSheet.Copy
For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp
With Application.FileDialog(2)
.Show: .AllowMultiSelect = False
ActiveWorkbook.SaveAs .SelectedItems(1)
End With
ExitSub:
ActiveWorkbook.Close (False)
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

 

[PAT_excel]

Anh sửa lại code như sau giúp em nhe

Sub XuatFile()
Dim shp As Shape
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error GoTo ExitSub
ActiveSheet.Copy
For Each shp In ActiveSheet.Shapes
shp.Delete
Next shp
With Application.FileDialog(2)
.Show: .AllowMultiSelect = False
ActiveWorkbook.SaveAs .SelectedItems(1)
End With
ExitSub:
ActiveWorkbook.Close (False)
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Có một chút xíu trong code phải sửa là unprotect sheet trước khi cho sheet copy nhưng mình đã tự sửa code được rồi. Cảm ơn LamNA nhiều.

 

[ManhHungMHNH]

Code rất hữu ích, mình cũng đang cần. Nhưng mình muốn khi xuất ra file mới để lưu. Thì file mới không còn lưu công thức của file gốc. Mình cảm ơn ạ.

 

[PAT_excel]

Có một chút xíu trong code phải sửa là unprotect sheet trước khi cho sheet copy nhưng mình đã tự sửa code được rồi. Cảm ơn LamNA nhiều.

Qua học hỏi của các bạn, mình đã tạo được file có các button để làm các công việc nhưng code vẫn bị chạy không đúng ý tưởng. Mình gửi file nhờ các bạn sửa / thêm code giúp mình nhé. Cảm ơn mọi người trước.

 

[giaiphap]

Qua học hỏi của các bạn, mình đã tạo được file có các button để làm các công việc nhưng code vẫn bị chạy không đúng ý tưởng. Mình gửi file nhờ các bạn sửa / thêm code giúp mình nhé. Cảm ơn mọi người trước.

Không biết đúng ý bạn không nửa, chổ nào chưa đúng nêu lên ở đây luôn.

 

[PAT_excel]

Không biết đúng ý bạn không nửa, chổ nào chưa đúng nêu lên ở đây luôn.

Cảm ơn bạn nhiều. Đúng 100% ý của tôi.