Vấn đề chia nhiều sheet phức tạp ! (1 người xem)

[kechuong]

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 đỡ !

 

[Hoàng Tuấn 868]

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.

 

[kechuong]

Bạn tham khảo tại đây xem sao.

cám ơn bạn !mình có thử qua, nhưng phải sửa lại code , mình lại không biết về VBA, nên đăng bài xin mọi người giúp đỡ !

 

[ngo ly]

Gần đạt nhưng ko rõ mục đích của bạn cần đúng thứ tự ko

 

[Nhattanktnn]

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

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

 

[kechuong]

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: 23/10/20

Bạn xem file

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!