Giúp em rút gọn hàm xử lý (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

taibalem0711

Thành viên mới
Tham gia
3/6/13
Bài viết
39
Được thích
1
Em có 2 hàm giùm để xóa và copy lại mà nó dài quá. Mấy a/c giúp đỡ em rút ngắn lại với.
Em có tới 33 sheet lận.

1/ Dùng để xóa số liệu các sheet:
Sub Clears()
Worksheets(2).Range("B7:C61,B79:C133,B151:C205,B223:C277,B295:C349,B367:C421,B439:C493").ClearContents
Worksheets(3).Range("B7:C61,B79:C133,B151:C205,B223:C277,B295:C349,B367:C421,B439:C493").ClearContents
......
Worksheets(33).Range("B7:C61,B79:C133,B151:C205,B223:C277,B295:C349,B367:C421,B439:C493").ClearContents
end Sub

2/ Dùng để copy và paste số liệu tới các sheet:
* Copy B7:C61
Sub Copys()
Sheet1.Range("B7:C61").Copy Sheet2.Range("B7:C61")
Sheet1.Range("B7:C61").Copy Sheet3.Range("B7:C61")
......
Sheet1.Range("B7:C61").Copy Sheet33.Range("B7:C61")
end Sub

* Copy B79:C133
Sub Copys()
Sheet1.Range("B79:C133").Copy Sheet2.Range("B79:C133")
Sheet1.Range("B79:C133").Copy Sheet3.Range("B79:C133")
......
Sheet1.Range("B79:C133").Copy Sheet33.Range("B79:C133")
end Sub

* Copy B151:C205....
 
Em có 2 hàm giùm để xóa và copy lại mà nó dài quá. Mấy a/c giúp đỡ em rút ngắn lại với.
Em có tới 33 sheet lận.

1/ Dùng để xóa số liệu các sheet:
Sub Clears()
Worksheets(2).Range("B7:C61,B79:C133,B151:C205,B223:C277,B295:C349,B367:C421,B439:C493").ClearContents
Worksheets(3).Range("B7:C61,B79:C133,B151:C205,B223:C277,B295:C349,B367:C421,B439:C493").ClearContents
......
Worksheets(33).Range("B7:C61,B79:C133,B151:C205,B223:C277,B295:C349,B367:C421,B439:C493").ClearContents
end Sub

2/ Dùng để copy và paste số liệu tới các sheet:
* Copy B7:C61
Sub Copys()
Sheet1.Range("B7:C61").Copy Sheet2.Range("B7:C61")
Sheet1.Range("B7:C61").Copy Sheet3.Range("B7:C61")
......
Sheet1.Range("B7:C61").Copy Sheet33.Range("B7:C61")
end Sub

* Copy B79:C133
Sub Copys()
Sheet1.Range("B79:C133").Copy Sheet2.Range("B79:C133")
Sheet1.Range("B79:C133").Copy Sheet3.Range("B79:C133")
......
Sheet1.Range("B79:C133").Copy Sheet33.Range("B79:C133")
end Sub

* Copy B151:C205....

Đây là cần câu, tuỳ bạn câu trong cái "ao" của bạn.
PHP:
Public Sub Xoa()
Dim Ws As Worksheet
For Each Ws In Worksheets
    If Ws.Name <> "Sheet1" Then
        Ws.Range("B7:C61,B79:C133,B151:C205,B223:C277,B295:C349,B367:C421,B439:C493").ClearContents
    End If
Next
End Sub

Public Sub Copy_()
Dim Ws As Worksheet
For Each Ws In Worksheets
    If Ws.Name <> "Sheet1" Then
        With Ws
            .Range("B7:C61").Value = Sheet1.Range("B7:C61").Value
            .Range("B79:C133").Value = Sheet1.Range("B79:C133").Value
            .Range("B151:C205").Value = Sheet1.Range("B151:C205").Value
            '..................................................'
        End With
    End If
Next
End Sub
 
Web KT

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

Back
Top Bottom