Tạo nút VBA để copy một sheet có sẳn

Liên hệ QC
H

hoctot ex

Thành viên mới
Tham gia
11/10/14
Bài viết
6
Được thích
0
chào cả nhà! em có một thắc mắc mong muốn được các chuyên gia diễn đàn giúp đở
em cần tạo một nút bấm, có chức năng là mỗi khi nhấn vào là sẽ tự động tạo ra một sheet mới tương tự như một sheet đã có sẵn trong file, mỗi lần làm như vậy rất là đơn giản không cần phải nhấn chuột copy.
em rất mong được cả nhà thương tình giúp đỡ , thank!!!
 
hoctot ex đã viết:
chào cả nhà! em có một thắc mắc mong muốn được các chuyên gia diễn đàn giúp đở
em cần tạo một nút bấm, có chức năng là mỗi khi nhấn vào là sẽ tự động tạo ra một sheet mới tương tự như một sheet đã có sẵn trong file, mỗi lần làm như vậy rất là đơn giản không cần phải nhấn chuột copy.
em rất mong được cả nhà thương tình giúp đỡ , thank!!!
Nhấp chuột vào đây để mở rộng...
Đằng nào cũng phải bấm chuột, thôi thì bấm chuột phải rồi copy cho khỏe gà.
Muốn code thì code thế này

Sheets("ABC").Copy After:= Sheets(Sheets.count)
 
hoctot ex đã viết:
chào cả nhà! em có một thắc mắc mong muốn được các chuyên gia diễn đàn giúp đở
em cần tạo một nút bấm, có chức năng là mỗi khi nhấn vào là sẽ tự động tạo ra một sheet mới tương tự như một sheet đã có sẵn trong file, mỗi lần làm như vậy rất là đơn giản không cần phải nhấn chuột copy.
em rất mong được cả nhà thương tình giúp đỡ , thank!!!
Nhấp chuột vào đây để mở rộng...

Chẳng có chuyên gia nào làm việc này đâu bạn ạ vì nó chẳng đơn giản hơn như bạn nghĩ đâu. Còn để học để biết vận dụng vào trường hợp khác thì bạn recode Macro là biết liền mà.
 
Lần chỉnh sửa cuối:
ndu96081631 đã viết:
Vậy cũng hơi lâu. Tôi thì làm khác chút: rà chuột vào sheet, giữ Ctrl và kéo, thả... Xong! Khỏi macro mắc cổ gì ráo
Nhấp chuột vào đây để mở rộng...
nếu 1,2 sheet thì em không hỏi đâu, nhưng mỗi 1 file của e hơn cả 20-30 sheet vì vậy luôn cần phải đi chọn lựa, với lại tất cả các sheet này cơ bản from đều dùng giống nhau, chỉ khác nội dung thôi. bởi vậy em mới có ý định tạo ra một nút lệnh ở những sheet vừa mới tạo ra, cứ mỗi lần cần thêm sheet mới là bắm vào là có, mất công đi chọn. các bạn thấy như vậy có hợp lý không. mong mọi người giúp đở nhiều,....
 
hoctot ex đã viết:
nếu 1,2 sheet thì em không hỏi đâu, nhưng mỗi 1 file của e hơn cả 20-30 sheet vì vậy luôn cần phải đi chọn lựa, với lại tất cả các sheet này cơ bản from đều dùng giống nhau, chỉ khác nội dung thôi. bởi vậy em mới có ý định tạo ra một nút lệnh ở những sheet vừa mới tạo ra, cứ mỗi lần cần thêm sheet mới là bắm vào là có, mất công đi chọn. các bạn thấy như vậy có hợp lý không. mong mọi người giúp đở nhiều,....
Nhấp chuột vào đây để mở rộng...

1. Muốn 1 file có 30 Sheets bạn vào menu Tools | Option | General. Trong Sheets new workbook: bạn nhập số 30. Mở workbook mới bạn có luôn 30 Sheets.

2. Muốn Copy from giống nhau Bạn copy toàn bộ sheets mẫu -> chọn sheets đầu tiên -> bấm giữ Shift và chọn sheets cuối cùng -> đặt con trỏ vào A1 phải chuột chọn Paste special... và chọn chế độ Paste.

Tôi nghĩ nếu có chậm thì cũng chẳng chậm hơn bạn nhấn nút 30 lần là bao.
 
Lần chỉnh sửa cuối:
hoctot ex đã viết:
nếu 1,2 sheet thì em không hỏi đâu, nhưng mỗi 1 file của e hơn cả 20-30 sheet vì vậy luôn cần phải đi chọn lựa, với lại tất cả các sheet này cơ bản from đều dùng giống nhau, chỉ khác nội dung thôi. bởi vậy em mới có ý định tạo ra một nút lệnh ở những sheet vừa mới tạo ra, cứ mỗi lần cần thêm sheet mới là bắm vào là có, mất công đi chọn. các bạn thấy như vậy có hợp lý không. mong mọi người giúp đở nhiều,....
Nhấp chuột vào đây để mở rộng...


Cách 1 (Code theo yêu cầu của bạn, và cũng dành cho 1 số tín đồ Excel chuyên dùng phím tắt, mỗi lần đụng đến con chuột rồi click phải copy sheet cảm thấy khó chịu):
Bạn tạo 1 Sub này vào Module

PHP: 
Sub mCopyActiveSheet()
ActiveSheet.Copy After:=ActiveSheet
End Sub

Sau đó ra ngoài Excel, mở hộp thoại RunMacro lên, chọn Option và gán phím tắt cho nó (Ví dụ Ctrl+Alt+C).
Như vậy mỗi lần muốn copy 1 sheet hiện hành ra sheet mới, bạn chỉ cần ấn tổ hợp phím Ctrl+alt+C.


Cách 2: Bạn không cần viết code mà dùng phím tắt (Excel có phím tắt mà
Alt+E, M sau đó Alt+C rồi Enter
Nhấp chuột vào đây để mở rộng...


Cách 3: Giống anh ndu

Cách 4: Giống TrungChinhs
 
Lần chỉnh sửa cuối:
cadafi đã viết:
Cách 1 (Code theo yêu cầu của bạn, và cũng dành cho 1 số tín đồ Excel chuyên dùng phím tắt, mỗi lần đụng đến con chuột rồi click phải copy sheet cảm thấy khó chịu):
Bạn tạo 1 Sub này vào Module

PHP: 
Sub mCopyActiveSheet()
ActiveSheet.Copy After:=ActiveSheet
End Sub

Sau đó ra ngoài Excel, mở hộp thoại RunMacro lên, chọn Option và gán phím tắt cho nó (Ví dụ Ctrl+Alt+C).
Như vậy mỗi lần muốn copy 1 sheet hiện hành ra sheet mới, bạn chỉ cần ấn tổ hợp phím Ctrl+alt+C.


Cách 2: Bạn không cần viết code mà dùng phím tắt (Excel có phím tắt mà


Cách 3: Giống anh ndu

Cách 4: Giống TrungChinhs
Nhấp chuột vào đây để mở rộng...
Nhân chủ đề này xin cho tôi hỏi một vấn đề liên quan đến việc Move or copy sheet.
- Tôi Thường phải thực hiện việc Move or copy 2 hoặc nhiều hơn 2 sheet trong 1 File Excel có rất nhiều Sheet đến một Workbooks mới và đặt tên thành 1 File mới. Các Anh chị hướng dẫn giúp tôi cách làm sao cho nhanh nhất với. Vì tôi có rất nhiều file phải Move or copy 2 để gửi đi.
- Vấn đề thứ 2 là: Khi tôi thực hiện việc Move or copy 2 sheet để lưu và tạo thành 1 file mới chứa 2 sheet này thì thường có các Name được đi theo vào trong ở trong file mới mà tôi không muốn.
- Rất mong được các Anh chị trên diễn đàn Hướng dẫn giúp. Xin cảm ơn!.
 
Thuyanhanoi đã viết:
Nhân chủ đề này xin cho tôi hỏi một vấn đề liên quan đến việc Move or copy sheet.
- Tôi Thường phải thực hiện việc Move or copy 2 hoặc nhiều hơn 2 sheet trong 1 File Excel có rất nhiều Sheet đến một Workbooks mới và đặt tên thành 1 File mới. Các Anh chị hướng dẫn giúp tôi cách làm sao cho nhanh nhất với. Vì tôi có rất nhiều file phải Move or copy 2 để gửi đi.
- Vấn đề thứ 2 là: Khi tôi thực hiện việc Move or copy 2 sheet để lưu và tạo thành 1 file mới chứa 2 sheet này thì thường có các Name được đi theo vào trong ở trong file mới mà tôi không muốn.
- Rất mong được các Anh chị trên diễn đàn Hướng dẫn giúp. Xin cảm ơn!.
Nhấp chuột vào đây để mở rộng...
- Mở file gốc
- Chuyển những sheet có công thức về giá trị.
- Xóa những Name có liên quan.
- Chọn những sheet trên rồi lưu sang file mới.
- Lưu và đóng file mới
- Đóng file gốc lại với điều kiện là không lưu

- Tiếp tục lại ý số 1
 
Hai Lúa Miền Tây đã viết:
- Mở file gốc
- Chuyển những sheet có công thức về giá trị.
- Xóa những Name có liên quan.
- Chọn những sheet trên rồi lưu sang file mới.
- Lưu và đóng file mới
- Đóng file gốc lại với điều kiện là không lưu

- Tiếp tục lại ý số 1
Nhấp chuột vào đây để mở rộng...
Anh Hai lúa ơi!. Còn Cách nào khác nữa không? Nếu làm như vậy mà em lỡ tay Yes kể như là tiêu.
File excel của em là file điểm các môn học "Kết quả và các thông tin của học sinh từ lúc vào nhập học đến lúc ra trường" nên có rất nhiều sheet. Thông thường em Move or copy 2 sheet để Giáo viên lấy danh sách và và nhập điểm số vào rồi gửi lại cho em. Nếu có code VBA Move or copy 2 sheet này tới Workbooks mới đặt tên file và lưu thì tốt biết mấy (với điều kiện file mới không chưa name khi Move or copy). Bác giúp em với!.
 
Thuyanhanoi đã viết:
Anh Hai lúa ơi!. Còn Cách nào khác nữa không? Nếu làm như vậy mà em lỡ tay Yes kể như là tiêu.
File excel của em là file điểm các môn học "Kết quả và các thông tin của học sinh từ lúc vào nhập học đến lúc ra trường" nên có rất nhiều sheet. Thông thường em Move or copy 2 sheet để Giáo viên lấy danh sách và và nhập điểm số vào rồi gửi lại cho em. Nếu có code VBA Move or copy 2 sheet này tới Workbooks mới đặt tên file và lưu thì tốt biết mấy (với điều kiện file mới không chưa name khi Move or copy). Bác giúp em với!.
Nhấp chuột vào đây để mở rộng...

Thì qui trình làm tôi diễn đạt ở trên là dùng VBA đó. Tuy nhiên muốn làm được hay không thì coi thử file của bạn thế nào, muốn copy cái nào. Bạn nói lý thuyết thì mình cũng xin trả lời lý thuyết vậy.
 
Cho chọt vô cái coi sao nha
PHP: 
Sub CopySheetToNewWB()
Dim sh As Worksheet, NewFileName
With ActiveWindow.SelectedSheets
   .Copy
   With ActiveWorkbook
      For Each sh In .Worksheets
         sh.UsedRange.Value = sh.UsedRange.Value
      Next
      NewFileName = Application.GetSaveAsFilename
      .SaveAs NewFileName & "xlsx"
      .Close
   End With
End With
End Sub
 
quanghai1969 đã viết:
Cho chọt vô cái coi sao nha
PHP: 
Sub CopySheetToNewWB()
Dim sh As Worksheet, NewFileName
With ActiveWindow.SelectedSheets
   .Copy
   With ActiveWorkbook
      For Each sh In .Worksheets
         sh.UsedRange.Value = sh.UsedRange.Value
      Next
      NewFileName = Application.GetSaveAsFilename
      .SaveAs NewFileName & "xlsx"
      .Close
   End With
End With
End Sub
Nhấp chuột vào đây để mở rộng...

Còn xử lý name, bắt lỗi file lưu trùng.
 
quanghai1969 đã viết:
Cho chọt vô cái coi sao nha
PHP: 
Sub CopySheetToNewWB()
Dim sh As Worksheet, NewFileName
With ActiveWindow.SelectedSheets
   .Copy
   With ActiveWorkbook
      For Each sh In .Worksheets
         sh.UsedRange.Value = sh.UsedRange.Value
      Next
      NewFileName = Application.GetSaveAsFilename
      .SaveAs NewFileName & "xlsx"
      .Close
   End With
End With
End Sub
Nhấp chuột vào đây để mở rộng...
- Cảm ơn Anh nhiều!. Ứng dụng code của Anh để copy 1 sheet thì Ok luôn nhưng Còn Name thì code của Anh vẫn mang theo!.. Nay em muốn copy 2 sheet Có tên là Nhap_diem và Phieu_diem cùng một lúc tới cùng 1 Workbooks mới đặt tên file và lưu.
Anh sửa code giúp em với nhé!. Em cảm ơn anh nhiều.
 

File đính kèm

  • Copy 2 sheet.rar
    983.9 KB · Đọc: 234
Lần chỉnh sửa cuối:
Thuyanhanoi đã viết:
- Cảm ơn Anh nhiều!. Ứng dụng code của Anh để copy 1 sheet thì Ok luôn nhưng Còn Name thì code của Anh vẫn mang theo!.. Nay em muốn copy 2 sheet Có tên là Nhap_diem và Phieu_diem cùng một lúc tới cùng 1 Workbooks mới đặt tên file và lưu.
Anh sửa code giúp em với nhé!. Em cảm ơn anh nhiều.
Nhấp chuột vào đây để mở rộng...
PHP: 
Sub CopySheetToNewWB()
Dim sh As Worksheet, NewFileName, Name As Name
With ThisWorkbook.Sheets(Array("Nhap_diem", "Phieu_diem"))
   .Copy
   With ActiveWorkbook
      For Each sh In .Worksheets
         sh.UsedRange.Value = sh.UsedRange.Value
      Next
      For Each Name In .Names
         Name.Visible = True
         Name.Delete
      Next
      NewFileName = Application.GetSaveAsFilename
      .SaveAs NewFileName & "xlsx"
      .Close
   End With
End With
End Sub
Hai Lúa Miền Tây đã viết:
Còn xử lý name, bắt lỗi file lưu trùng.
Nhấp chuột vào đây để mở rộng...
Thôi kệ đi, bẫy lỗi nhiều quá mệt code lắm.
 
quanghai1969 đã viết:
PHP: 
Sub CopySheetToNewWB()
Dim sh As Worksheet, NewFileName, Name As Name
With ThisWorkbook.Sheets(Array("Nhap_diem", "Phieu_diem"))
   .Copy
   With ActiveWorkbook
      For Each sh In .Worksheets
         sh.UsedRange.Value = sh.UsedRange.Value
      Next
      For Each Name In .Names
         Name.Visible = True
         Name.Delete
      Next
      NewFileName = Application.GetSaveAsFilename
      .SaveAs NewFileName & "xlsx"
      .Close
   End With
End With
End Sub

Thôi kệ đi, bẫy lỗi nhiều quá mệt code lắm.
Nhấp chuột vào đây để mở rộng...
- Em cảm ơn Anh Hải nhiều nhé!. Code chạy rất đúng ý em rồi. Rất cảm ơn Anh!.
 
Thuyanhanoi đã viết:
- Em cảm ơn Anh Hải nhiều nhé!. Code chạy rất đúng ý em rồi. Rất cảm ơn Anh!.
Nhấp chuột vào đây để mở rộng...
- Gửi Anh Hải!. Em kiểm tra Code chạy với file thử rất tốt. Tuy nhiên trên thực tế sheet Nhap_diem và Phieu_diem của em được protect sheet với mục đích công thức tính điểm trong đó không được thay đổi vì nếu công thức bị thay đổi làm kết quả học tập của học sinh bị thay đổi khi em gửi mẫu đi kể như em tiêu luôn.
- Mà khi 2 sheet này được protect sheet thì code trên bài 15 lại bị báo lỗi. Anh sửa lại giúp giùm em với!. Cảm ơn Anh nhiều!.
 
Thuyanhanoi đã viết:
- Gửi Anh Hải!. Em kiểm tra Code chạy với file thử rất tốt. Tuy nhiên trên thực tế sheet Nhap_diem và Phieu_diem của em được protect sheet với mục đích công thức tính điểm trong đó không được thay đổi vì nếu công thức bị thay đổi làm kết quả học tập của học sinh bị thay đổi khi em gửi mẫu đi kể như em tiêu luôn.
- Mà khi 2 sheet này được protect sheet thì code trên bài 15 lại bị báo lỗi. Anh sửa lại giúp giùm em với!. Cảm ơn Anh nhiều!.
Nhấp chuột vào đây để mở rộng...
Thì mở protect ra bằng lệnh Unprotect
PHP: 
Sub CopySheetToNewWB()
Dim sh As Worksheet, NewFileName, Name As Name
With ThisWorkbook.Sheets(Array("Nhap_diem", "Phieu_diem"))
   .Copy
   With ActiveWorkbook
      For Each sh In .Worksheets
         sh.Unprotect
         'sh.Unprotect 123 'Nếu có đặt pass thì xài dòng này
         sh.UsedRange.Value = sh.UsedRange.Value
      Next
      For Each Name In .Names
         Name.Visible = True
         Name.Delete
      Next
      NewFileName = Application.GetSaveAsFilename
      .SaveAs NewFileName & "xlsx"
      .Close
   End With
End With
End Sub
 
quanghai1969 đã viết:
Thì mở protect ra bằng lệnh Unprotect
PHP: 
Sub CopySheetToNewWB()
Dim sh As Worksheet, NewFileName, Name As Name
With ThisWorkbook.Sheets(Array("Nhap_diem", "Phieu_diem"))
   .Copy
   With ActiveWorkbook
      For Each sh In .Worksheets
         sh.Unprotect
         'sh.Unprotect 123 'Nếu có đặt pass thì xài dòng này
         sh.UsedRange.Value = sh.UsedRange.Value
      Next
      For Each Name In .Names
         Name.Visible = True
         Name.Delete
      Next
      NewFileName = Application.GetSaveAsFilename
      .SaveAs NewFileName & "xlsx"
      .Close
   End With
End With
End Sub
Nhấp chuột vào đây để mở rộng...
- Do File của em có công thức nên em điều chỉnh như sau:
Mã: 
Sub CopySheetToNewWB()Dim sh As Worksheet, NewFileName, Name As Name
With ThisWorkbook.Sheets(Array("Nhap_diem", "Phieu_diem"))
   .Copy
   With ActiveWorkbook
      For Each sh In .Worksheets
         'sh.Unprotect
         'sh.Unprotect 123 'N?u có d?t pass thì xài dòng này
         sh.UsedRange.[COLOR=#b22222]FormulaR1C1[/COLOR] = sh.UsedRange.[COLOR=#b22222]FormulaR1C1[/COLOR]
      Next
      For Each Name In .Names
         Name.Visible = True
         Name.Delete
      Next
      NewFileName = Application.GetSaveAsFilename
      .SaveAs NewFileName & "xls"
      [COLOR=#b22222]sh.Protect  ' Chỗ này không [/COLOR][COLOR=#B22222]Protect sheet được mong anh chỉnh giúp[/COLOR]
      .Close
   End With
End With
End Sub
- File mới chứa 2 sheet là nhap_diem và sheet phieu_diem khi gửi tới giáo viên nhập điểm phải được Protect sheet để không ai tự ý thay đổi công thức tính điểm. Em có điều chỉnh code ở phía trên nhưng vẫn còn lỗi. Mong Anh sửa lại giúp em vơi!. Cảm ơn Anh nhiều
 
Lần chỉnh sửa cuối:
Thuyanhanoi đã viết:
- Do File của em có công thức nên em điều chỉnh như sau:
Mã: 
Sub CopySheetToNewWB()Dim sh As Worksheet, NewFileName, Name As Name
With ThisWorkbook.Sheets(Array("Nhap_diem", "Phieu_diem"))
   .Copy
   With ActiveWorkbook
      For Each sh In .Worksheets
         'sh.Unprotect
         'sh.Unprotect 123 'N?u có d?t pass thì xài dòng này
         sh.UsedRange.[COLOR=#b22222]FormulaR1C1[/COLOR] = sh.UsedRange.[COLOR=#b22222]FormulaR1C1[/COLOR]
      Next
      For Each Name In .Names
         Name.Visible = True
         Name.Delete
      Next
      NewFileName = Application.GetSaveAsFilename
      .SaveAs NewFileName & "xls"
      [COLOR=#b22222]sh.Protect  ' Chỗ này không [/COLOR][COLOR=#B22222]Protect sheet được mong anh chỉnh giúp[/COLOR]
      .Close
   End With
End With
End Sub
- File mới chứa 2 sheet là nhap_diem và sheet phieu_diem khi gửi tới giáo viên nhập điểm phải được Protect sheet để không ai tự ý thay đổi công thức tính điểm. Em có điều chỉnh code ở phía trên nhưng vẫn còn lỗi. Mong Anh sửa lại giúp em vơi!. Cảm ơn Anh nhiều
Nhấp chuột vào đây để mở rộng...

Hết hiểu luôn rồi. Nếu công thức có liên quan đến Name thì sao?
Cứ thử coi trúng không. Bói hoài.
PHP: 
Sub CopySheetToNewWB()
Dim sh As Worksheet, NewFileName, Name As Name
With ThisWorkbook.Sheets(Array("Nhap_diem", "Phieu_diem"))
   .Copy
   With ActiveWorkbook
      For Each sh In .Worksheets
         sh.Protect
      Next
      For Each Name In .Names
         Name.Visible = True
         Name.Delete
      Next
      NewFileName = Application.GetSaveAsFilename
      .SaveAs NewFileName & "xlsx"
      .Close
   End With
End With
End Sub
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

LuuAnh980
Công thức thỏa mãn 2 điều kiện thì có dấu X, nếu không thì =""
Trả lời
8
Đọc
50
ptm0412
ptm0412
72G1
File và thư mục
Trả lời
4
Đọc
60
SA_DQ
SA_DQ
kyo
  • Suggestion
Bài viết: SAP Scripting – Excel và SAP (P2)
    • Thích
Trả lời
14
Đọc
8K
pic vo123
P
S
Sao excel lại biến dữ liệu thành dữ liệu nhiều các con số?
Trả lời
12
Đọc
164
syquyen1987
S
Emyeuexcel
  • Question
VBA lưu file, in, và mở lại file gốc ban đầu
Trả lời
4
Đọc
95
Hoàng Tuấn 868
H
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom