Tạo WorkBook mới từ Workbook đang mở (1 người xem)

[vanquangdy]

Các AC trên diễn đàn chỉ dùm em có cách nào tạo WB từ wb đang mở và giống như wb đang mở đó và lưu vào file đó luôn. Cụ thể là em có một wb báo cáo quý I trong file báo cáo (tại ổ D chẳng hạn) Sau khi em làm báo cáo quý I xong muốn từ wb Quý I em tạo một wb quý II giống như quý I , lưu vào file báo cáo đó và đặt tên là báo cáo quý II và tiếp tục là quý III, quý IV . Mong các AC giúp với

 

[Hoàng Trọng Nghĩa]

Bạn gửi file lên đi, tôi sẽ thử làm cho bạn.

 

[vanquangdy]

Từ WB bao cao quy I khi bấm vào nút tạo mới thì sẽ tạo ra một WB giống như WB này nhưng thay đổi thành WB có tên là bao cao quy II và tiếp tục cho quý III, IV và ô B2 sẽ thành "Báo Cáo Thu Chi Quý II năm 2012" . Các WB này cùng nằm trong file BAO CAO
Xin các AC giúp dùm

 

[Quang_Hải]

Ban xem thử file này coi được chưa

 

[vanquangdy]

anh cho em hỏi thêm là em muốn tạo ra 3 wb của 3 quý nhưng vẫn làm việc trên wb hiện hành (quý I), như cách anh làm là nó sẽ nhảy ngay tới quý cuối của wb vừa tạo. Cám ơn anh nhiều

 

[Quang_Hải]

Coi cái này xem thế nào. Nếu có file cũ sẽ bị ghi đè luôn nha. Nếu không muôn bị ghi đè thì gỡ bỏ dòng lệnh Application.DisplayAlerts=0

 

[vanquangdy]

đúng rồi anh quanghai a, nhưng em muốn copy luôn cả workbook (gồm sh1, sh2..) chứ không riêng sh1 vì các quý giống nhau chỉ khác số liêu thôi, anh giúp em với

 

[Quang_Hải]

Nếu vậy thì phải làm theo cách lúc đầu thôi

 

[vanquangdy]

em chạy thử nó bị lỗi , em làm thử cách này nhưng nó chỉ copy wb và đổi tên theo quý thôi nhưng không copy hết cách dữ liệu trong các sh nhờ anh xem sửa giúp

 

[Quang_Hải]

Sao không chạy thử cái file mình làm lần cuối đó

 

[vanquangdy]

em chạy file của anh đó, nó bị lỗi anh quanghai ơi

 

[Quang_Hải]

Mình test thấy ok mà, bị lỗi gì vậy?

 

[vanquangdy]

nó lỗi như vậy đó, và chỉ thây đổi tên của ô A2 từ "quýI" thành "quý II" thôi, anh xem file word đính kèm

 

[Quang_Hải]

Vần đề là file này chạy trên máy tính của mình thì không thấy lỗi gì cả, anh chi nào có cao kiến gi không???

 

[Hoàng Trọng Nghĩa]

nó lỗi như vậy đó, và chỉ thây đổi tên của ô A2 từ "quýI" thành "quý II" thôi, anh xem file word đính kèm

Vào Tool > Macro > Security... tại đây check vào Trust Access to Visual Basic Project rồi OK là không còn gặp lỗi này nữa!

 

[vanquangdy]

chạy tốt rồi anh ơi, nhưng cho em hỏi thêm điều này là sau khi chạy xong tất cả điều đúng chỉ có tại quý I cell A2 thay vì báo cáo thu chi quý I thì lại là quý VI (số quý cuối cùng của lựa chọn) các anh sửa dùm em với

 

[Quang_Hải]

Thêm dòng màu đỏ để save file, dòng đỏ ở phía dưới chắc không cần thiết vì file này không được save sau khi chay code. Nếu save sẽ mất hết code

Private Sub CommandButton1_Click()
Application.ScreenUpdating = 0
ThisWorkbook.Save
Path = ThisWorkbook.Path
For i = 2 To 4
quy = Application.Roman(i)
With ThisWorkbook
[A2] = "B" & ChrW(193) & "O" & " C" & ChrW(193) & "O THU CHI QU" & Chr(221) & " " & quy & " N" & ChrW(258) & "M 2012"
.ActiveSheet.DrawingObjects.Delete
With .VBProject.VBComponents(.Sheets("sheet1").CodeName).CodeModule
.DeleteLines 1, .CountOfLines
End With
.SaveCopyAs Path & "\BAO CAO QUY " & quy & ".xls "
End With
Next
[A2] = "B" & ChrW(193) & "O" & " C" & ChrW(193) & "O THU CHI QU" & Chr(221) & " " & Application.Roman(1) & " N" & ChrW(258) & "M 2012"
Application.ScreenUpdating = 1
End Sub

Hoăc là như thế này để trả cell a2 vê giá tri lúc đầu

Private Sub CommandButton1_Click()
Application.ScreenUpdating = 0
ThisWorkbook.Save
temp = [a2].Value
Path = ThisWorkbook.Path
For i = 2 To 4
quy = Application.Roman(i)
With ThisWorkbook
[a2] = "B" & ChrW(193) & "O" & " C" & ChrW(193) & "O THU CHI QU" & Chr(221) & " " & quy & " N" & ChrW(258) & "M 2012"
.ActiveSheet.DrawingObjects.Delete
With .VBProject.VBComponents(.Sheets("sheet1").CodeName).CodeModule
.DeleteLines 1, .CountOfLines
End With
.SaveCopyAs Path & "\BAO CAO QUY " & quy & ".xls "
End With
Next
[a2] = temp
Application.ScreenUpdating = 1
End Sub