Vấn đề chia nhiều sheet phức tạp !

kechuong

Thành viên mới
Tham gia ngày
11 Tháng tám 2020
Bài viết
28
Được thích
3
Điểm
15
Tuổi
26
Ví Dụ: sheet1 co 2 cot minh muốn chia thành nhiều sheet, mỗi sheet 10 dòng! Ở mỗi sheet mình muốn chia thành 5 cột ! mình có gửi theo 1 file đính kèm! có làm 1 ví dụ o sheet2 ! hy vọng mọi người giúp đỡ !
 

File đính kèm

Hoàng Tuấn 868

Thành viên tích cực
Tham gia ngày
9 Tháng mười một 2019
Bài viết
871
Được thích
667
Điểm
360
Ví Dụ: sheet1 co 2 cot minh muốn chia thành nhiều sheet, mỗi sheet 10 dòng! Ở mỗi sheet mình muốn chia thành 5 cột ! mình có gửi theo 1 file đính kèm! có làm 1 ví dụ o sheet2 ! hy vọng mọi người giúp đỡ !
Bạn tham khảo tại đây xem sao.
 

ngo ly

Thành viên mới
Tham gia ngày
23 Tháng ba 2017
Bài viết
28
Được thích
11
Điểm
165
Gần đạt nhưng ko rõ mục đích của bạn cần đúng thứ tự ko
 

File đính kèm

Nhattanktnn

Thành viên tích cực
Tham gia ngày
11 Tháng mười một 2016
Bài viết
1,071
Được thích
994
Điểm
360
Ví Dụ: sheet1 co 2 cot minh muốn chia thành nhiều sheet, mỗi sheet 10 dòng! Ở mỗi sheet mình muốn chia thành 5 cột ! mình có gửi theo 1 file đính kèm! có làm 1 ví dụ o sheet2 ! hy vọng mọi người giúp đỡ !
Bạn xem file
PHP:
Sub ChiaSheet()
Dim Arr(), I As Long, J As Long, sSheet As Long, R As Long, K As Long
Dim ws As Worksheet, MainSheet As Worksheet
Const sRow As Long = 10
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set MainSheet = Sheets("Sheet1")
For Each ws In ActiveWorkbook.Sheets
    If ws.Name <> "Sheet1" Then ws.Delete
Next
With MainSheet
    Arr = .Range("A1:B100").Value
End With
    R = UBound(Arr, 1)
    K = R / sRow
    If R Mod sRow <> 0 Then
        MsgBox "Du lieu khong chia het cho " & sRow & "dong"
        Exit Sub
    End If
    
    For J = 1 To K
        Sheets.Add after:=Sheets(Sheets.Count)
        Set ws = ActiveSheet
        With ws
            For I = 1 To sRow
                .Cells(I, 1) = Arr((J - 1) * sRow + I, 1)
                .Cells(I, 2) = Arr((J - 1) * sRow + I, 2)
            Next
            For I = 1 To sRow / 2
                .Cells(1, 5 + I) = Arr((J - 1) * sRow + 2 * I - 1, 1)
                .Cells(3, 5 + I) = Arr((J - 1) * sRow + 2 * I - 1, 2)
                
                .Cells(2, 5 + I) = Arr((J - 1) * sRow + 2 * I, 1)
                .Cells(4, 5 + I) = Arr((J - 1) * sRow + 2 * I, 2)
            Next
        End With
    Next
MainSheet.Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
 

File đính kèm

kechuong

Thành viên mới
Tham gia ngày
11 Tháng tám 2020
Bài viết
28
Được thích
3
Điểm
15
Tuổi
26
Gần đạt nhưng ko rõ mục đích của bạn cần đúng thứ tự ko
Cám ơn bạn nhiều nha! code của bạn cũng giống ý mình luôn á !
Bài đã được tự động gộp:

Bạn xem file
PHP:
Sub ChiaSheet()
Dim Arr(), I As Long, J As Long, sSheet As Long, R As Long, K As Long
Dim ws As Worksheet, MainSheet As Worksheet
Const sRow As Long = 10
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set MainSheet = Sheets("Sheet1")
For Each ws In ActiveWorkbook.Sheets
    If ws.Name <> "Sheet1" Then ws.Delete
Next
With MainSheet
    Arr = .Range("A1:B100").Value
End With
    R = UBound(Arr, 1)
    K = R / sRow
    If R Mod sRow <> 0 Then
        MsgBox "Du lieu khong chia het cho " & sRow & "dong"
        Exit Sub
    End If
   
    For J = 1 To K
        Sheets.Add after:=Sheets(Sheets.Count)
        Set ws = ActiveSheet
        With ws
            For I = 1 To sRow
                .Cells(I, 1) = Arr((J - 1) * sRow + I, 1)
                .Cells(I, 2) = Arr((J - 1) * sRow + I, 2)
            Next
            For I = 1 To sRow / 2
                .Cells(1, 5 + I) = Arr((J - 1) * sRow + 2 * I - 1, 1)
                .Cells(3, 5 + I) = Arr((J - 1) * sRow + 2 * I - 1, 2)
               
                .Cells(2, 5 + I) = Arr((J - 1) * sRow + 2 * I, 1)
                .Cells(4, 5 + I) = Arr((J - 1) * sRow + 2 * I, 2)
            Next
        End With
    Next
MainSheet.Activate
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
cám ơn anh nhiều nha !quá đúng ý lun rồi!
 
Top Bottom