Cách Chia 1 Sheet Ra Thành Nhiều File EXCEL Với Đúng Số Dòng (1 người xem)

redbirdd206 · 8/1/20

Chào các anh, chị ạ
Cho em hỏi là em hiện tại đang làm thủ công, copy paste các dữ liệu từ 1 sheet ra thành nhiều file excel . Ví dụ cột A1 em có gần 700 dòng, mà em đang cần tách ra cứ 45 dòng lại thành 1 file excel đuôi CSV để dùng cho tool ạ (mỗi dòng khoảng 4-15 cột ạ), hoặc anh chị giúp em lưu ra file XSL rùi em mở lại rùi lưu lại thành csv cũng được ạ, như vậy cũng giúp đỡ e rất nhiều rùi!
Ví dụ đến dòng cuối mà còn nhỏ hơn 45 thì cũng lưu lại thành file excel mới ạ. Mà dạo này gần tết khối lượng công việc quá nhiều, nên làm bằng tay tốn rất nhiều thời gian ạ. Em có gửi các anh, chị file mẫu để xem ạ. Em xin cảm ơn anh, chị nhiều, Mong anh, chị giúp em ạ!

snow25 · 8/1/20

redbirdd206 đã viết:
Chào các anh, chị ạ
Cho em hỏi là em hiện tại đang làm thủ công, copy paste các dữ liệu từ 1 sheet ra thành nhiều file excel . Ví dụ cột A1 em có gần 700 dòng, mà em đang cần tách ra cứ 45 dòng lại thành 1 file excel đuôi CSV để dùng cho tool ạ (mỗi dòng khoảng 4-15 cột ạ), hoặc anh chị giúp em lưu ra file XSL rùi em mở lại rùi lưu lại thành csv cũng được ạ, như vậy cũng giúp đỡ e rất nhiều rùi!
Ví dụ đến dòng cuối mà còn nhỏ hơn 45 thì cũng lưu lại thành file excel mới ạ. Mà dạo này gần tết khối lượng công việc quá nhiều, nên làm bằng tay tốn rất nhiều thời gian ạ. Em có gửi các anh, chị file mẫu để xem ạ. Em xin cảm ơn anh, chị nhiều, Mong anh, chị giúp em ạ!

Bạn thử code này nhé.

Mã:

Sub tachfile()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim arr, kq(1 To 45, 1 To 15), i As Long, j As Long, lr As Long, ten As String, wb As Workbook, a As Long, b As Integer
    With Sheets("sheet1")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         arr = .Range("a5:o" & lr).Value
         For i = 1 To UBound(arr)
             a = a + 1
             If a = 46 Then
                b = b + 1
                Set wb = Workbooks.Add
                wb.Sheets(1).Range("A5:oE49").Value = kq
                ten = ThisWorkbook.Path & "\" & b & ".CSV"
                wb.SaveAs ten
                wb.Close
                Erase kq
                a = 1
             End If
             For j = 1 To 5
                kq(a, j) = arr(i, j)
             Next j
       Next i
           If a Then
              b = b + 1
                Set wb = Workbooks.Add
                wb.Sheets(1).Range("A5:o49").Value = kq
                ten = ThisWorkbook.Path & "\" & b & ".CSV"
                wb.SaveAs ten
                wb.Close
          End If
  End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

VetMini · 8/1/20

snow25 đã viết:
... For i = 1 To UBound(arr)
a = a + 1
If a = 46 Then
b = b + 1
Set wb = Workbooks.Add
wb.Sheets(1).Range("A5E49").Value = kq
ten = ThisWorkbook.Path & "\" & b & ".CSV"
wb.SaveAs ten
wb.Close
Erase kq
a = 1
End If
For j = 1 To 5
kq(a, j) = arr(i, j)
Next j
Next i

Đếm gì cực vậy?

Const SEGMENTLEN = 45
...
Set rg = .Range("a5 : o5").Resize( SEGMENTLEN)
For i = 1 To lastRow Step SEGMENTLEN
kq = rg.Value
...
Set rg = rg.Offset(SEGMENTLEN)
Next i

snow25 · 8/1/20

VetMini đã viết:
Đếm gì cực vậy?

Const SEGMENTLEN = 45
...
Set rg = .Range("a5 : o5").Resize( SEGMENTLEN)
For i = 1 To lastRow Step SEGMENTLEN
kq = rg.Value
...
Set rg = rg.Offset(SEGMENTLEN)
Next i

Em cảm ơn nhé.

redbirdd206 · 8/1/20

Em cảm ơn anh chị đã giúp, nhưng sao em ấn F5 chạy nó lại ko ra chỗ lưu file ạ. màn hình vẫn đứng im anh chị ạ.

snow25 · 8/1/20

Mã:

Sub tachfile()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim arr, i As Long, j As Long, lr As Long, ten As String, wb As Workbook, a As Long, b As Integer
    With Sheets("sheet1")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         For i = 5 To lr Step 45
               b=b+1
                arr = .Range("a" & i).Resize(45, 15).Value
                Set wb = Workbooks.Add
                wb.Sheets(1).Range("A5:oE49").Value = arr
                ten = ThisWorkbook.Path & "\" & b & ".CSV"
                wb.SaveAs ten
                wb.Close
       Next i
  End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

redbirdd206 đã viết:
Em cảm ơn anh chị đã giúp, nhưng sao em ấn F5 chạy nó lại ko ra chỗ lưu file ạ. màn hình vẫn đứng im anh chị ạ.

Nó lưu file vào cùng thư mục chứa nó.Bạn kiểm tra xem có đúng không.

redbirdd206 · 8/1/20

snow25 đã viết:
Nó lưu file vào cùng thư mục chứa nó.Bạn kiểm tra xem có đúng không.

em cảm ơn nhiều ạ. em làm đc rùi. chúc anh chị 1 ngày vui vẻ ạ

befaint · 8/1/20

redbirdd206 đã viết:
rùi

Rùi đục may ra 1 file.

ten = ThisWorkbook.Path & "\" & b & ".CSV"

VetMini · 8/1/20

Xin lỗi. Nhầm môi trường. Coi như tôi không có nói gì.

redbirdd206 · 8/1/20

snow25 đã viết:

Mã:

Sub tachfile()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim arr, i As Long, j As Long, lr As Long, ten As String, wb As Workbook, a As Long, b As Integer
    With Sheets("sheet1")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         For i = 5 To lr Step 45
               b=b+1
                arr = .Range("a" & i).Resize(45, 15).Value
                Set wb = Workbooks.Add
                wb.Sheets(1).Range("A5:oE49").Value = arr
                ten = ThisWorkbook.Path & "\" & b & ".CSV"
                wb.SaveAs ten
                wb.Close
       Next i
  End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Nó lưu file vào cùng thư mục chứa nó.Bạn kiểm tra xem có đúng không.

Chị ơi giúp em với, e thử file khác thì nó chỉ lấy dữ liệu đúng 5 cột đầu từ A đến E, mà file mới của e đến tận cột R thì em chỉnh lại ở chỗ nào ạ. Em mò từ nãy mà không ra em mới comment nhờ chị ạ

redbirdd206 · 8/1/20

Em chỉnh "For j = 1 To 18 để nó lấy dữ liệu đến cột R mà nó bảo lỗi em thử mãi mà không biết làm thế nào

snow25 · 8/1/20

redbirdd206 đã viết:
Chị ơi giúp em với, e thử file khác thì nó chỉ lấy dữ liệu đúng 5 cột đầu từ A đến E, mà file mới của e đến tận cột R thì em chỉnh lại ở chỗ nào ạ. Em mò từ nãy mà không ra em mới comment nhờ chị ạ

Bạn thử.

redbirdd206 đã viết:
View attachment 230973
Em chỉnh "For j = 1 To 18 để nó lấy dữ liệu đến cột R mà nó bảo lỗi em thử mãi mà không biết làm thế nào

Bạn thử code này nhé.

Mã:

Sub tachfile()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim arr, i As Long, j As Long, lr As Long, ten As String, wb As Workbook, a As Long, b As Integer
    With Sheets("sheet1")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         For i = 5 To lr Step 45
               b=b+1
                arr = .Range("a" & i).Resize(45, 18).Value
                Set wb = Workbooks.Add
                wb.Sheets(1).Range("A5:r49").Value = arr
                ten = ThisWorkbook.Path & "\" & b & ".CSV"
                wb.SaveAs ten
                wb.Close
       Next i
  End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

redbirdd206 · 8/1/20

snow25 đã viết:

Bạn thử.

Bạn thử code này nhé.

Mã:

Sub tachfile()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim arr, i As Long, j As Long, lr As Long, ten As String, wb As Workbook, a As Long, b As Integer
    With Sheets("sheet1")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         For i = 5 To lr Step 45
               b=b+1
                arr = .Range("a" & i).Resize(45, 18).Value
                Set wb = Workbooks.Add
                wb.Sheets(1).Range("A5:r49").Value = arr
                ten = ThisWorkbook.Path & "\" & b & ".CSV"
                wb.SaveAs ten
                wb.Close
       Next i
  End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

e cảm ơn chị nhiều ạ, e làm đc rùi ạ

redbirdd206 · 8/1/20

snow25 đã viết:

Bạn thử.

Bạn thử code này nhé.

Mã:

Sub tachfile()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
    Dim arr, i As Long, j As Long, lr As Long, ten As String, wb As Workbook, a As Long, b As Integer
    With Sheets("sheet1")
         lr = .Range("A" & Rows.Count).End(xlUp).Row
         For i = 5 To lr Step 45
               b=b+1
                arr = .Range("a" & i).Resize(45, 18).Value
                Set wb = Workbooks.Add
                wb.Sheets(1).Range("A5:r49").Value = arr
                ten = ThisWorkbook.Path & "\" & b & ".CSV"
                wb.SaveAs ten
                wb.Close
       Next i
  End With
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Chị ơi cho em hỏi, file CSV e xuất ra được rồi ạ, nhưng lúc mở bằng notepad cho tool chạy thì nó không đọc được nó hiện lỗi như hình e gửi ạ. có cách nào e không phải mở file đấy lên rùi copy qua tab khác, rùi lưu lại không ạ

snow25 · 8/1/20

redbirdd206 đã viết:
Chị ơi cho em hỏi, file CSV e xuất ra được rồi ạ, nhưng lúc mở bằng notepad cho tool chạy thì nó không đọc được nó hiện lỗi như hình e gửi ạ. có cách nào e không phải mở file đấy lên rùi copy qua tab khác, rùi lưu lại không ạ

Là sao nhỉ bạn.Mà sao bạn gọi là chị nhỉ.Bạn nói cụ thể mình xem nào.

redbirdd206 · 8/1/20

snow25 đã viết:
Là sao nhỉ bạn.Mà sao bạn gọi là chị nhỉ.Bạn nói cụ thể mình xem nào.

dạ, em xin lỗi a... e tưởng a là con gái..khi tool e chạy thì tool e chạy bằng file CSV a ạ, nhưng lúc chạy code VBA xuất file từ excel ra, tool e ko đọc được , em kiểm tra bằng notepad thì được hình e ghim ở comment trên a ạ. Bình thường lúc e kiểm tra file CSV bằng notepad thì nó phải kiểu này a ạ. e có ghim ở dưới ạ. còn file CSV xuất từ VBA ra bị lỗi e phải mở rùi copy xong qua tab khác paste rùi lưu lại đuôi CSV mới chạy được ạ

befaint · 8/1/20

redbirdd206 đã viết:
cho tool chạy thì nó không đọc được nó hiện lỗi

Ngay từ bài #2 mình biết chắc chắn sẽ lỗi rồi.
1/
Set wb = Workbooks.Add '----> Xảy ra trường hợp không phải lúc nào cũng chỉ có 1 sheet ở workbook mới.
mà có dòng này
Application.DisplayAlerts = False
thì không thể biết cái lỗi lúc lưu file *.csv

2/
ten = ThisWorkbook.Path & "\" & b & ".CSV"
wb.SaveAs ten
---> Hai dòng này sẽ cho kết quả là một tập tin dị dạng, mở lên bằng MS Excel còn bị lỗi ấy chứ. Lý do không khai báo FileFormat

** Bạn gửi cái format mà 'tool' của bạn nhận được lên đây, khi đó mới tính tiếp được.
Loại *.csv nó hơi khác dạng *.xls*

redbirdd206 · 8/1/20

befaint đã viết:
Ngay từ bài #2 mình biết chắc chắn sẽ lỗi rồi.
1/
Set wb = Workbooks.Add '----> Xảy ra trường hợp không phải lúc nào cũng chỉ có 1 sheet ở workbook mới.
mà có dòng này
Application.DisplayAlerts = False
thì không thể biết cái lỗi lúc lưu file *.csv

2/
ten = ThisWorkbook.Path & "\" & b & ".CSV"
wb.SaveAs ten
---> Hai dòng này sẽ cho kết quả là một tập tin dị dạng, mở lên bằng MS Excel còn bị lỗi ấy chứ. Lý do không khai báo FileFormat

** Bạn gửi cái format mà 'tool' của bạn nhận được lên đây, khi đó mới tính tiếp được.
Loại *.csv nó hơi khác dạng *.xls*

Em cảm ơn a, e ko biết tool bên e định dạng như thế nào, nhưng e có file mọi lần chạy đây ạ. Cũng là file CSV mà mở bằng notepad thì ra bình thường ko bị lỗi như xuất từ VBA Excel a ạ .
Link file đây a ạ https://docs.google.com/spreadsheets/d/1R1V0eeLMxT-YEAwwx96HVU1cOYLbuxH9OXGW6fIUQGk/edit?usp=sharing

Bài đã được tự động gộp: 8/1/20

befaint đã viết:
Ngay từ bài #2 mình biết chắc chắn sẽ lỗi rồi.
1/
Set wb = Workbooks.Add '----> Xảy ra trường hợp không phải lúc nào cũng chỉ có 1 sheet ở workbook mới.
mà có dòng này
Application.DisplayAlerts = False
thì không thể biết cái lỗi lúc lưu file *.csv

2/
ten = ThisWorkbook.Path & "\" & b & ".CSV"
wb.SaveAs ten
---> Hai dòng này sẽ cho kết quả là một tập tin dị dạng, mở lên bằng MS Excel còn bị lỗi ấy chứ. Lý do không khai báo FileFormat

** Bạn gửi cái format mà 'tool' của bạn nhận được lên đây, khi đó mới tính tiếp được.
Loại *.csv nó hơi khác dạng *.xls*

a ơi, a làm ơn giúp e với ạ. E cảm ơn a

befaint · 8/1/20

redbirdd206 đã viết:
Link file

Bạn đóng gói thành *.zip rồi gửi lên đây. Chứ link kia sao biết được.

redbirdd206 · 8/1/20

befaint đã viết:
Bạn đóng gói thành *.zip rồi gửi lên đây. Chứ link kia sao biết được.

là gửi cả tool lên ạ.

tool thì công ty em không cho public ạ. Vì tool thuê coder nước ngoài viết a ạ. Bình thường e dùng googlesheet ở excel để làm và xuất ra file CSV để dùng để chạy ạ

Cách Chia 1 Sheet Ra Thành Nhiều File EXCEL Với Đúng Số Dòng (1 người xem)

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

Thành viên mới

File đính kèm

Thành viên gạo cội

Đang đi tìm hòn đá

Thành viên gạo cội

Thành viên mới

File đính kèm

Thành viên gạo cội

Thành viên mới

|||||||||||||

Đang đi tìm hòn đá

Thành viên mới

Thành viên mới

Thành viên gạo cội

Thành viên mới

Thành viên mới

File đính kèm

Thành viên gạo cội

Thành viên mới

File đính kèm

|||||||||||||

Thành viên mới

|||||||||||||

Thành viên mới

Sinh nhật lần 19 GPE