Xin Sửa lệnh VBA

Quảng cáo

kiendaide1

Thành viên mới
Tham gia ngày
3 Tháng tư 2013
Bài viết
16
Được thích
0
Điểm
301
Em có lệnh VBA 100 đồng ra 1 tệp nhưng khi tách tệp ra thì không có tiêu đề. Có bác nào sửa hộ em khi tách từng tập tin thì các tập tin đó đều có tiêu đề ạ. Em cảm ơn
Lện em đính kèm ạ
 

File đính kèm

  • VBA TÁCH 100 dong trên EXCEL.txt
    1.1 KB · Đọc: 6

befaint

|||||||||||||
Tham gia ngày
6 Tháng một 2011
Bài viết
11,360
Được thích
13,519
Điểm
5,168
Kien đại để hay Kiên dài? Thích tên nick quá cơ. :)

Set RangeTieuDe = ThisSheet.Range("Vung tieu de")
For p = 1 To ThisSheet.UsedRange.Rows.Count Step RowsInFile
Set wb = Workbooks.Add
RangeTieuDe.Copy wb.Sheets(1).Range("A1")
'...
RangeToCopy.Copy wb.Sheets(1).Range("A2")

Next p
 

kiendaide1

Thành viên mới
Tham gia ngày
3 Tháng tư 2013
Bài viết
16
Được thích
0
Điểm
301
Kien đại để hay Kiên dài? Thích tên nick quá cơ. :)

Set RangeTieuDe = ThisSheet.Range("Vung tieu de")
For p = 1 To ThisSheet.UsedRange.Rows.Count Step RowsInFile
Set wb = Workbooks.Add
RangeTieuDe.Copy wb.Sheets(1).Range("A1")
'...
RangeToCopy.Copy wb.Sheets(1).Range("A2")

Next p
Phiền anh sửa luôn vào lệnh gửi lại lệnh cho em xin với ạ. em cảm ơn anh.
 

quick87

(/ội...
Tham gia ngày
8 Tháng tư 2008
Bài viết
331
Được thích
294
Điểm
718
Phiền anh sửa luôn vào lệnh gửi lại lệnh cho em xin với ạ. em cảm ơn anh.
Mình sửa thử theo gợi ý của bài #2, bạn tham khảo nhé :
PHP:
Sub Test()
  Dim wb As Workbook
  Dim ThisSheet As Worksheet
  Dim NumOfColumns As Integer
  Dim RangeTieuDe As Range
  Dim RangeToCopy As Range
  Dim WorkbookCounter As Integer
  Dim RowsInFile
  Dim Prefix As String

  Application.ScreenUpdating = False

  'Initialize data
  Set ThisSheet = ThisWorkbook.ActiveSheet
  Set RangeTieuDe = ThisSheet.Range("Vung tieu de")
  NumOfColumns = ThisSheet.UsedRange.Columns.Count
  WorkbookCounter = 1
  RowsInFile = 500                   'how many rows (incl. header) in new files?
  Prefix = "test"                    'prefix of the file name

  For p = 1 To ThisSheet.UsedRange.Rows.Count Step RowsInFile
    Set wb = Workbooks.Add
    RangeTieuDe.Copy wb.Sheets(1).Range("A1")

    'Paste the chunk of rows for this file
    Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p + RowsInFile - 1, NumOfColumns))
    RangeToCopy.Copy wb.Sheets(1).Range("A2")

    'Save the new workbook, and close it
    wb.SaveAs ThisWorkbook.Path & "\" & Prefix & "_" & WorkbookCounter
    wb.Close

    'Increment file counter
    WorkbookCounter = WorkbookCounter + 1
  Next p

  Application.ScreenUpdating = True
  Set wb = Nothing
End Sub
 

kiendaide1

Thành viên mới
Tham gia ngày
3 Tháng tư 2013
Bài viết
16
Được thích
0
Điểm
301
Mình sửa thử theo gợi ý của bài #2, bạn tham khảo nhé :
PHP:
Sub Test()
  Dim wb As Workbook
  Dim ThisSheet As Worksheet
  Dim NumOfColumns As Integer
  Dim RangeTieuDe As Range
  Dim RangeToCopy As Range
  Dim WorkbookCounter As Integer
  Dim RowsInFile
  Dim Prefix As String

  Application.ScreenUpdating = False

  'Initialize data
  Set ThisSheet = ThisWorkbook.ActiveSheet
  Set RangeTieuDe = ThisSheet.Range("Vung tieu de")
  NumOfColumns = ThisSheet.UsedRange.Columns.Count
  WorkbookCounter = 1
  RowsInFile = 500                   'how many rows (incl. header) in new files?
  Prefix = "test"                    'prefix of the file name

  For p = 1 To ThisSheet.UsedRange.Rows.Count Step RowsInFile
    Set wb = Workbooks.Add
    RangeTieuDe.Copy wb.Sheets(1).Range("A1")

    'Paste the chunk of rows for this file
    Set RangeToCopy = ThisSheet.Range(ThisSheet.Cells(p, 1), ThisSheet.Cells(p + RowsInFile - 1, NumOfColumns))
    RangeToCopy.Copy wb.Sheets(1).Range("A2")

    'Save the new workbook, and close it
    wb.SaveAs ThisWorkbook.Path & "\" & Prefix & "_" & WorkbookCounter
    wb.Close

    'Increment file counter
    WorkbookCounter = WorkbookCounter + 1
  Next p

  Application.ScreenUpdating = True
  Set wb = Nothing
End Sub
em cam ơn anh ạ
 
Quảng cáo
Top Bottom