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

Liên hệ QC

kechuong

Thành viên mới
Tham gia
11/8/20
Bài viết
37
Được thích
3
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

  • Book3.xlsm
    11 KB · Đọc: 11
Gần đạt nhưng ko rõ mục đích của bạn cần đúng thứ tự ko
 

File đính kèm

  • Book3.xlsm
    32.2 KB · Đọc: 7
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

  • Book3.xlsm
    21.2 KB · Đọc: 7
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!
 
Web KT
Back
Top Bottom