xin code copy paste value của sheet file excel này sang sheet file excel khác (1 người xem)

[quoc nhat]

Chào buổi sáng GPE!
Chúc cả nhà một ngày mới tốt lành!
Xin lỗi đã làm phiền cả nhà sớm thế này!
Chả là em muốn tìm code Copy paste value dữ liệu của sheet hiện hành của file excel này sang sheet 1 của một workbook mới dữ nguyên định dạng( tự động mở workbook mới và paste value vào sheet 1) nhưng tìm kiếm trên dỉển đàn mải không thấy. Nên xin làm phiền mọi người viết giúp em đoạn code với nội dung như em trình bày ở trên .
Em cảm ơn nhiều!

 

[be_09]

dạ em biết là code trong module không copy nhưng trên code của sheet cần copy có vài sự kiện như Worksheet_Change(), Worksheet_Selection(), worksheet_Active()...
em muốn bỏ các đoạn code đó đi nhưng mà không biết phải làm sao?
Anh nhiệt tình quá!
Cảm ơn anh Be09!
P/s: em muốn dùng các CommandButton vì nó gán được các icon trong sinh động hơn.

Lỡ phóng lao rồi nên anh chơi nốt cái cuối cùng, thêm 1 doạn code nữa nếu không được thì chạy.

Sub LuuVaXoaCode()
Dim Theo_Doi
Theo_Doi = ActiveWorkbook.Name
Theo_Doi = ActiveSheet.Name
Sheets(Theo_Doi).Copy
ActiveSheet.DrawingObjects.Delete

'Delete code cua worksheet
With ActiveWorkbook        
For Each Theo_Doi In .Worksheets            
With .VBProject.VBComponents(Theo_Doi.CodeName).CodeModule                
.DeleteLines 1, .CountOfLines            
End With        
Next 

'Hien cua so Save As
Application.Dialogs(xlDialogSaveAs).Show
ActiveWindow.Close
End With
End Sub

Code mới thêm chỗ màu đỏ.

 

[quoc nhat]

Lỡ phóng lao rồi nên anh chơi nốt cái cuối cùng, thêm 1 doạn code nữa nếu không được thì chạy.

Sub LuuVaXoaCode()
Dim Theo_Doi
Theo_Doi = ActiveWorkbook.Name
Theo_Doi = ActiveSheet.Name
Sheets(Theo_Doi).Copy
ActiveSheet.DrawingObjects.Delete

'Delete code cua worksheet
With ActiveWorkbook        
For Each Theo_Doi In .Worksheets            
With .VBProject.VBComponents(Theo_Doi.CodeName).CodeModule                
.DeleteLines 1, .CountOfLines            
End With        
Next 

'Hien cua so Save As
Application.Dialogs(xlDialogSaveAs).Show
ActiveWindow.Close
End With
End Sub

Code mới thêm chỗ màu đỏ.

Lỗi 1004 anh ơi
nếu khó quá thì mình bỏ qua đi anh.
em làm bằng tay cũng được
cảm ơn anh rất nhiều!

 

[quoc nhat]

Lỗi 1004 anh ơi
nếu khó quá thì mình bỏ qua đi anh.
em làm bằng tay cũng được
cảm ơn anh rất nhiều!

Đã rỏ nguyên nhân gây ra lỗi:
Mục: Security chưa đánh dấu chọn vào mục Trust access to Visual Basic Project
Một lần nữa xin cảm ơn anh
Làm phiền anh quá!
Chúc anh ngày nghỉ vui vẻ

 

[minhthu2506]

Chào các anh chị,

Em là thành viên mới và đang trong quá trình học hỏi về VBA. Xin các anh chị tư vấn giúp em trường hợp này với ạ.

Em có 1 file macro, sau một quá trình tính toán, em muốn copy & paste value kết quả tính toán ra một file mới. Tuy nhiên, file kết quả sẽ có 1 số thay đổi so với file gốc (ví dụ một số sensitive row sẽ bị delete và thêm 1 số row mới). Em đã thử tạo macro nhưng chưa đạt được kết quả như mong muốn.

Nhờ các anh chị xem và kiểm tra giúp em với ạ. Xin chân thành cảm ơn.

 

[pinklove]

Lỡ phóng lao rồi nên anh chơi nốt cái cuối cùng, thêm 1 doạn code nữa nếu không được thì chạy.

Sub LuuVaXoaCode()
Dim Theo_Doi
Theo_Doi = ActiveWorkbook.Name
Theo_Doi = ActiveSheet.Name
Sheets(Theo_Doi).Copy
ActiveSheet.DrawingObjects.Delete

'Delete code cua worksheet
With ActiveWorkbook        
For Each Theo_Doi In .Worksheets            
With .VBProject.VBComponents(Theo_Doi.CodeName).CodeModule                
.DeleteLines 1, .CountOfLines            
End With        
Next 

'Hien cua so Save As
Application.Dialogs(xlDialogSaveAs).Show
ActiveWindow.Close
End With
End Sub

Code mới thêm chỗ màu đỏ.

Bạn cho mình hỏi cái code này chỉ copy được 1 sheet. Nếu mình muốn copy 2 sheet hoặc hơn nữa thì phải sửa thế nào???

 

[be_09]

Bạn cho mình hỏi cái code này chỉ copy được 1 sheet. Nếu mình muốn copy 2 sheet hoặc hơn nữa thì phải sửa thế nào???

Bạn bỏ 2 dòng code hoặc đánh dấu nháy trước 2 dòng code này.

'Theo_Doi = ActiveSheet.Name
'Sheets(Theo_Doi).Copy

 

[pinklove]

Bạn bỏ 2 dòng code hoặc đánh dấu nháy trước 2 dòng code này.

'Theo_Doi = ActiveSheet.Name
'Sheets(Theo_Doi).Copy

Nếu làm thế này nó sẽ copy tất cả các sheet. Có cách nào chỉ copy những sheet mình chọn không bạn??

 

[be_09]

Nếu làm thế này nó sẽ copy tất cả các sheet. Có cách nào chỉ copy những sheet mình chọn không bạn??

Muốn copy sheet nào thì thay tên sheet đó vào chỗ Theo_Doi của 2 dòng này.

Theo_Doi = ActiveSheet.Name
Sheets(Theo_Doi).Copy

 

[pinklove]

Muốn copy sheet nào thì thay tên sheet đó vào chỗ Theo_Doi của 2 dòng này.

Theo_Doi = ActiveSheet.Name
Sheets(Theo_Doi).Copy

Nếu thế này thì cũng chỉ copy được sheet đó sang book mới chứ không copy 2 sheet sang cùng 1 book được. Ví dụ giờ mình muốn copy cả sheet Theo_doi và Sheet2 sang cùng 1 workbook mới thì làm sao bạn.

 

[Quang_Hải]

Nếu thế này thì cũng chỉ copy được sheet đó sang book mới chứ không copy 2 sheet sang cùng 1 book được. Ví dụ giờ mình muốn copy cả sheet Theo_doi và Sheet2 sang cùng 1 workbook mới thì làm sao bạn.

Nguyên tắc là thế này. Bạn tự nghiên cứu nhé
Sheets(Array("A", "B", "C")).Copy

 

[lhthai]

Nguyên tắc là thế này. Bạn tự nghiên cứu nhé
Sheets(Array("A", "B", "C")).Copy

Mượn code Anh quanghai1969 nghiên cứu thử

Sub copy()
Application.DisplayAlerts = False
Sheets(Array("Sheet1", "Sheet2", "Sheet3")).copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Sheet1.[B1], FileFormat:=xlExcel8
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub

 

[pinklove]

Mượn code Anh quanghai1969 nghiên cứu thử

Sub copy()
Application.DisplayAlerts = False
Sheets(Array("Sheet1", "Sheet2", "Sheet3")).copy
ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & "\" & Sheet1.[B1], FileFormat:=xlExcel8
ActiveWorkbook.Close
Application.DisplayAlerts = True
End Sub

Không thấy nó hoạt động gì cả

 

[lhthai]

Không thấy nó hoạt động gì cả

Copy 3 sheet ra 1 workbook mới với tên file ở cột B1 (File New) và lưu cùng đường dẫn tại file đang mở.

 

[nguyenpc]

Xin nhờ các bác sửa lại code giúp e ạ: E đang để code là copy từ "Nhomhangbd" sang "Nhomhangcopy" nhưng e chỉ muốn nó copy value sang thôi chứ không muốn copy toàn bộ sang, xin nhờ các bác sửa lại giúp e với ạ. Thanks các bác.
Option Explicit
Private Sub worksheet_Change(ByVal Target As Range)
If Not Intersect(Range("Nhomhangbd"), Target) Is Nothing Then
With Range("Nhomhangbd")
.Copy Destination:=Sheets("NHOM HANG").Range("Nhomhangcopy")
End With
End If
End Sub