Nhờ giúp đỡ code vba chạy all sheet trong workbook

Liên hệ QC

thanhtamop

Thành viên mới
Tham gia
5/5/09
Bài viết
4
Được thích
3
Như tiêu đề, sau thời gian học hỏi mò mẫm tìm hiểu và viết các code vba phục vụ công việc. Hiện mình bị vướng vấn đề sau:
1. Workbook nhiều sheet, giả sử code vba của mình là code A. Nếu chạy code A từng sheet ( với phím tắt gán để bấm chạy) ít thì không sao, nhưng với số lượng nhiều sheet trong workbook có cấu trúc giống nhau mà chuyển từng sheet rồi bấm chạy code A từng sheet khá mất thời gian. Vậy nhờ các ace viết giùm mình code vba chạy hàng loạt tất cả các sheet trong workbook với code A của mình đã có sẵn giúp với nhé. Mình tìm nhiều trang trên mạng để học mà không thấy nói đến

2. Vấn đề phát sinh, nếu đã chạy hàng loạt tất cả các sheet trong workbook, nếu muốn loại trừ chạy với 1 hoặc 2 sheet trong workbook đó thì có giải pháp nào không?
Ví dụ như workbook có 10 sheet, chạy tất cả code A trên workbook trừ sheet9 chẳng hạn

Thanks các ace đã đọc và giúp đỡ
 
Như tiêu đề, sau thời gian học hỏi mò mẫm tìm hiểu và viết các code vba phục vụ công việc. Hiện mình bị vướng vấn đề sau:
1. Workbook nhiều sheet, giả sử code vba của mình là code A. Nếu chạy code A từng sheet ( với phím tắt gán để bấm chạy) ít thì không sao, nhưng với số lượng nhiều sheet trong workbook có cấu trúc giống nhau mà chuyển từng sheet rồi bấm chạy code A từng sheet khá mất thời gian. Vậy nhờ các ace viết giùm mình code vba chạy hàng loạt tất cả các sheet trong workbook với code A của mình đã có sẵn giúp với nhé. Mình tìm nhiều trang trên mạng để học mà không thấy nói đến

2. Vấn đề phát sinh, nếu đã chạy hàng loạt tất cả các sheet trong workbook, nếu muốn loại trừ chạy với 1 hoặc 2 sheet trong workbook đó thì có giải pháp nào không?
Ví dụ như workbook có 10 sheet, chạy tất cả code A trên workbook trừ sheet9 chẳng hạn

Cảm ơn các ace đã đọc và giúp đỡ

1.
Sub vande1
Dim ws as worksheet
For each ws in activeworkbook.worksheets
Macro1 'viết code của bạn vào đây"
Next
End sub
2.
Sub vande2
Dim ws as worksheet
For each ws in activeworkbook.worksheets
If not ws.name = "sheet9" then 'sheet9 ban k muon chay code
Macro1 'viết code của bạn vào đây"
End if
Next
End sub
 
Lần chỉnh sửa cuối:
Upvote 0
Như tiêu đề, sau thời gian học hỏi mò mẫm tìm hiểu và viết các code vba phục vụ công việc. Hiện mình bị vướng vấn đề sau:
1. Workbook nhiều sheet, giả sử code vba của mình là code A. Nếu chạy code A từng sheet ( với phím tắt gán để bấm chạy) ít thì không sao, nhưng với số lượng nhiều sheet trong workbook có cấu trúc giống nhau mà chuyển từng sheet rồi bấm chạy code A từng sheet khá mất thời gian. Vậy nhờ các ace viết giùm mình code vba chạy hàng loạt tất cả các sheet trong workbook với code A của mình đã có sẵn giúp với nhé. Mình tìm nhiều trang trên mạng để học mà không thấy nói đến

2. Vấn đề phát sinh, nếu đã chạy hàng loạt tất cả các sheet trong workbook, nếu muốn loại trừ chạy với 1 hoặc 2 sheet trong workbook đó thì có giải pháp nào không?
Ví dụ như workbook có 10 sheet, chạy tất cả code A trên workbook trừ sheet9 chẳng hạn

Cảm ơn các ace đã đọc và giúp đỡ
Ví dụ 2:
PHP:
Sub MultiSheets()
    Dim sh As Worksheet
    For Each sh In ThisWorkbook.Sheets
        If sh.Name <> "Sheet9" Then
           '  Code cua ban!
        End If
    Next sh
End Sub
 
Upvote 0
Cám ơn các ACE đã giúp đỡ, nhưng code trên chỉ chạy được trên activesheet

Sub vande1
Dim ws as worksheet
For each ws in activeworkbook.worksheets
'ví dụ
Range("A1")="done"
Next
End sub
(code bác Syquyen1987)

mình chạy deburg F8 để xem nguyên lý hoạt động nhưng thấy chạy trên activesheet xong chạy thêm 1 lần nữa rồi kết thúc sub chứ khôgn chạy qua sheet khác. Các bác xem lại giúp mình nhé
 
Upvote 0
Cám ơn các ACE. Mình đã tìm ra giải pháp rồi, Code như sau:
Sub MultiSheets()
Dim sh As Long
sh = Sheets.Count
For i = 1 To sh
Sheets(i).Select
'code vba muốn chạy
Next
End Sub

Nếu ace nào xem có cao kiến gì hay hơn thì reply hướng dẫn thêm nhé.
Cám ơn mọi người nhiều
 
Upvote 0
Cám ơn các ACE đã giúp đỡ, nhưng code trên chỉ chạy được trên activesheet

Sub vande1
Dim ws as worksheet
For each ws in activeworkbook.worksheets
'ví dụ
Range("A1")="done"
Next
End sub
(code bác Syquyen1987)

mình chạy deburg F8 để xem nguyên lý hoạt động nhưng thấy chạy trên activesheet xong chạy thêm 1 lần nữa rồi kết thúc sub chứ khôgn chạy qua sheet khác. Các bác xem lại giúp mình nhé
Bạn sửa Range("A1")="done" thành ws.Range("A1")="done"
 
Upvote 0
Cám ơn các ACE. Mình đã tìm ra giải pháp rồi, Code như sau:
Sub MultiSheets()
Dim sh As Long
sh = Sheets.Count
For i = 1 To sh
Sheets(i).Select
'code vba muốn chạy
Next
End Sub

Nếu ace nào xem có cao kiến gì hay hơn thì reply hướng dẫn thêm nhé.
Cám ơn mọi người nhiều
Câu lệnh Sheets(i).Select là thứ dở nhất mà người lập trình VBA nên tránh. Nó sẽ làm cho bảng tính bị "cà giật". Đó là chưa nói đến việc gặp sheet ẩn, code tèo
 
Upvote 0
Cám ơn các ACE đã giúp đỡ, nhưng code trên chỉ chạy được trên activesheet

Sub vande1
Dim ws as worksheet
For each ws in activeworkbook.worksheets
'ví dụ
Range("A1")="done"
Next
End sub
(code bác Syquyen1987)

mình chạy deburg F8 để xem nguyên lý hoạt động nhưng thấy chạy trên activesheet xong chạy thêm 1 lần nữa rồi kết thúc sub chứ khôgn chạy qua sheet khác. Các bác xem lại giúp mình nhé
Tại sheets không được chọn select nên phải là ws.range("A1") = "done" bạn nhé
 
Upvote 0
Option Explicit
Sub FixRow(ByVal rng As Range)
Dim Ws As Worksheet
Dim I As Long, cell As Range, MrgeWdth As Single, Ma As Range
Dim WithCellPaste As Long, ColPaste As Long, RowPaste As Long, CellPaste As Range, Diff As Single
On Error Resume Next
Diff = 0.75
Set Ws = rng.Worksheet
ColPaste = Ws.Columns.Count
For I = 1 To rng.Count
If rng(I) <> Empty Then
Set Ma = rng(I).MergeArea
For Each cell In Ma
MrgeWdth = MrgeWdth + cell.ColumnWidth + Diff
Next cell
Ma.RowHeight = 16.5
RowPaste = Ma.Row
Set CellPaste = Cells(RowPaste, ColPaste)
WithCellPaste = CellPaste.ColumnWidth
CellPaste.ColumnWidth = MrgeWdth
CellPaste = Ma.Value
rng(I, 1).Copy
CellPaste.PasteSpecial xlPasteFormats
CellPaste.WrapText = True
CellPaste.EntireRow.AutoFit
Ma.RowHeight = CellPaste.RowHeight + 16.5 / 5
CellPaste.Clear
CellPaste.ColumnWidth = WithCellPaste
End If
Next I
End Sub
Sub ChayBB()
Application.ScreenUpdating = False
FixRow Range("B7:N7")
FixRow Range("B12:N12")
Application.ScreenUpdating = True
End Sub


em có code này để fix row, nếu chạy cho từng sheet thì được, các anh chị rành code sửa giúp cho em chạy 1 cái toàn bộ các sheet chạy với ạ. em chân thành cám ơn
 

File đính kèm

  • HSQLCL.xlsm
    332.5 KB · Đọc: 24
Upvote 0
Trong sub FixRow, sửa dòng này
Set CellPaste = Cells(RowPaste, ColPaste)
Thành
Set CellPaste = Ws.Cells(RowPaste, ColPaste)

Và:
Sub ChayBB()
Dim ws
Application.ScreenUpdating = False
For Each ws In WorkSheets
FixRow ws.Range("B7:N7")
FixRow ws.Range("B12:N12")
Next ws
Application.ScreenUpdating = True
End Sub
 
Upvote 0
Trong sub FixRow, sửa dòng này
Set CellPaste = Cells(RowPaste, ColPaste)
Thành
Set CellPaste = Ws.Cells(RowPaste, ColPaste)

Và:
Sub ChayBB()
Dim ws
Application.ScreenUpdating = False
For Each ws In WorkSheets
FixRow ws.Range("B7:N7")
FixRow ws.Range("B12:N12")
Next ws
Application.ScreenUpdating = True
End Sub

Em đã làm thành công! Xin chân thành cám ơn anh. Chúc anh sức khỏe. Tiện thể cho em hỏi em muốn fix tất cả các row nhưng bỏ qua các row ẩn thì được không ạ . (row ẩn không muốn nó hiện ra ạ)
 
Upvote 0
Em đã làm thành công! Xin chân thành cám ơn anh. Chúc anh sức khỏe. Tiện thể cho em hỏi em muốn fix tất cả các row nhưng bỏ qua các row ẩn thì được không ạ . (row ẩn không muốn nó hiện ra ạ)
Cái code trên nó khủng bố lắm. Thêm chút xíu để cho "chạy tất cả mọi sheets" mà phải đọc từ đầu chí cuối xem có chỗ nào bị sót. Nếu phải thêm/sửa tác chất thì thà bạn mở thớt khác, nhờ những ngừoi khác rên đây viết code từ đầu khoẻ hơn.
 
Upvote 0
Cái code trên nó khủng bố lắm. Thêm chút xíu để cho "chạy tất cả mọi sheets" mà phải đọc từ đầu chí cuối xem có chỗ nào bị sót. Nếu phải thêm/sửa tác chất thì thà bạn mở thớt khác, nhờ những ngừoi khác rên đây viết code từ đầu khoẻ hơn.

Vanang. Em cám ơn ạ.
 
Upvote 0
Web KT

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

Back
Top Bottom