Không chạy được code copy Sh!

  • Thread starter Thread starter ThuNghi
  • Ngày gửi Ngày gửi
Liên hệ QC
T

ThuNghi

Hãy cho rồi sẽ nhận!
Thành viên đã mất
Tham gia
16/8/06
Bài viết
3,808
Được thích
4,449
Tôi dùng Ex 2007 để chạy code sau

PHP: 
Sub CopySheet()
    Sheets("SoCai").Copy After:=Sheets("SoCai")
    If SheetExists(SoTK) Then
      Sheets(SoTK).Delete
      ActiveSheet.Name = SoTK
    Else
      ActiveSheet.Name = SoTK
    End If
    XoaLinhTinh
    Sheets("SoCai").Select
End Sub
PHP: 
Private Function SheetExists(shName) As Boolean
    Dim x As Object
    On Error Resume Next
    Set x = ActiveWorkbook.Sheets(shName)
    If Err = 0 Then SheetExists = True _
        Else SheetExists = False
End Function
Sub XoaLinhTinh()
    Range("E1").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    'ActiveSheet.Shapes("CommandButton1").Select
    ActiveSheet.Shapes.Range(Array("CommandButton1", "CommandButton2")).Select
    Selection.Delete
End Sub
Mục đích là khi tạo 1 sổ cái mới là tôi copy sang 1 sh khác và đặt tên sh theo SoTK
Nhưng khi tạo được 27 sh mới thì nó lại báo lỗi.
Do tôi duyệt từ
for iSoTK=1 to SoTK
Khi iSoTK=28 thì báo lỗi.
Lần 2 tôi cho chạy
for iSoTK=28 to SoTK
Khi iSoTK=55 thì báo lỗi.
Nghĩa là chỉ cho copy có 27 sh.
Lỗi như sau
Nhờ các bạn giúp đỡ.
Cám ơn nhiều!
 

File đính kèm

  • BaoLoi.JPG
    BaoLoi.JPG
    14.4 KB · Đọc: 17
Theo em anh không nên coppy Sh mà chỉ coppy dữ liệu sau khi lọc rồi chuyển sang Sh đã định dạng sẵn
 
ThuNghi đóng mở ngoặc kép SoTK xem sao? Sau khi sửa mình Test trên 2003 thấy được mà.
 
Sau khi bỏ On Error Resume Next, Em thấy nó bị lỗi ở chỗ này nè anh Thu Nghi:
Set x = ActiveWorkbook.Sheets(shName)
Các Sheet được Copy trên Excel 2007 là SoCai, SoCai1, SoCai2, hình như anh muốn đặt tên là SoKT thì phải, vậy thì Lỗi là Set X
 
sealand đã viết:
ThuNghi đóng mở ngoặc kép SoTK xem sao? Sau khi sửa mình Test trên 2003 thấy được mà.
Nhấp chuột vào đây để mở rộng...
Em đã dim sotk as string rồi mà.
Nó bị lỗi như sau
http://support.microsoft.com/kb/210684
Đọan code trên là em for i theo range("SHTK") và tạo socailt, cứ tạo 1 sổ thì copy sang sh khác, bỏ hết link, object... và đa75t tên theo SoTK.
Sh NKC em có > 80.000 row nên không tiện đưa.
PHP: 
Option Explicit
Dim SoTK As String
Dim RngFound As Range, LastCell As Range, MyRng As Range
Dim eRow As Long, SoLan As Long, iR As Long, iL As Long, eR As Long, iC As Long, fR As Long
Dim iRow As Long, iSc As Long
Dim SoTien As Double, NoLuyKe As Double, CoLuyKe As Double
Dim WF As WorksheetFunction
Sub TaoSoCaiLT()
With Application
  .EnableEvents = False: .DisplayAlerts = False: .ScreenUpdating = False: .Calculation = xlCalculationManual
End With
Sheets("SoCai").Select
eRow = Sheets("Candoi").Range("SHTK").Rows.Count

For iSc = 1 To eRow
  SoTK = Sheets("Candoi").Range("SHTK").Cells(iSc, 1)
  Cells(1, 5) = SoTK
  TaoSoCai
  CopySheet
Next iSc

With Application
  .EnableEvents = True: .DisplayAlerts = True: .ScreenUpdating = True: .Calculation = xlCalculationAutomatic
End With
    

End Sub
Sub CopySheet()
    Sheets("SoCai").Copy After:=Sheets("SoCai")
    If SheetExists(SoTK) Then
      Sheets(SoTK).Delete
      ActiveSheet.Name = SoTK
    Else
      ActiveSheet.Name = SoTK
    End If
    XoaLinhTinh
    Sheets("SoCai").Select
End Sub

Sub TaoSoCai()
iRow = 2
Set WF = WorksheetFunction
Sheets("SoCai").Select
fR = 9
SoTK = Cells(1, 5)
With Sheets("NKC")
      .AutoFilterMode = False
      eRow = .[I400000].End(xlUp).Row 'cot TK Co'
    Set MyRng = .Range("H" & iRow & ":I" & eRow)
    SoLan = WorksheetFunction.CountIf(MyRng, SoTK)
    If SoLan = 0 Then
        'MsgBox "TK nay khong PS"
        GoTo bien
    End If
End With
Set RngFound = Sheets("Candoi").Range("SHTK").Find(SoTK, After:=Range("SHTK").Cells(1, 1), LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
        MatchCase:=False, SearchFormat:=False)
With RngFound
    Cells(2, 5) = .Offset(, -2) 'SKTK Sap
    Cells(1, 9) = .Offset(, 1) 'Ten TK
    Cells(fR - 2, 9) = .Offset(, 2) 'daukyNo
    Cells(fR - 2, 10) = .Offset(, 3) 'daukyNo
    NoLuyKe = .Offset(, 6)
    CoLuyKe = .Offset(, 7)
End With

With Application
  .EnableEvents = False: .DisplayAlerts = False: .ScreenUpdating = False: .Calculation = xlCalculationManual
End With

eR = [C400000].End(xlUp).Row
Range(Cells(fR, 1), Cells(400000, 14)).Clear 'Contents
iR = fR
With Sheets("NKC")
Set RngFound = .Cells(2, 8)
MyRng.NumberFormat = "000"
  For iL = 1 To SoLan
  With MyRng
    Set RngFound = .Find(SoTK, After:=RngFound, SearchOrder:=xlRows, LookIn:=xlValues, LookAt:=xlWhole)
    With RngFound
      Select Case RngFound.Column
      Case 8
        iC = 0
      Case 9
        iC = -1
      End Select
      ' iR = iR + 1
      Cells(iR, 1) = iR - 8 'SoTT'
      Cells(iR, 2) = .Offset(, -7 + iC) 'NgayHT'
      Cells(iR, 3) = .Offset(, -6 + iC)  'SoCT'
      Cells(iR, 4) = .Offset(, -5 + iC) 'NgayCT'
      Cells(iR, 5) = .Offset(, -4 + iC) '& "-" & .Offset(, -2 + iC) 'DienGiai
      Cells(iR, 7) = .Offset(, -2 + iC) 'TT NKC'
      Cells(iR, 9 - iC) = .Offset(, -1 + iC) 'So Tien'
      Cells(iR, 6) = .Offset(, 5 + iC) 'So Trang'
      '
      If iC = 0 Then iC = 1
      Cells(iR, 8) = .Offset(, iC)  'TkDu
      Cells(iR, 11) = .Offset(, 2 + iC) 'Ghi chu'
      iR = iR + 1
    End With
  End With
  Next iL
End With
'Copy footer vao socai
With Sheets("Footer")
    Range("Footer").Copy
End With

Cells(iR + 1, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
'gan dong tong cong
Cells(iR + 1, 9).FormulaR1C1 = "=SUM(R9C:R[-1]C)" 'iR -2
Cells(iR + 1, 10).FormulaR1C1 = "=SUM(R9C:R[-1]C)" 'iR -2
end sub
 
ThuNghi đã viết:
Tôi dùng Ex 2007 để chạy code sau

PHP: 
Sub CopySheet()
    Sheets("SoCai").Copy After:=Sheets("SoCai")
    If SheetExists(SoTK) Then
      Sheets(SoTK).Delete
      ActiveSheet.Name = SoTK
    Else
      ActiveSheet.Name = SoTK
    End If
    XoaLinhTinh
    Sheets("SoCai").Select
End Sub
PHP: 
Private Function SheetExists(shName) As Boolean
    Dim x As Object
    On Error Resume Next
    Set x = ActiveWorkbook.Sheets(shName)
    If Err = 0 Then SheetExists = True _
        Else SheetExists = False
End Function
Sub XoaLinhTinh()
    Range("E1").Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateInputOnly, AlertStyle:=xlValidAlertStop, Operator _
        :=xlBetween
        .IgnoreBlank = True
        .InCellDropdown = True
        .ShowInput = True
        .ShowError = True
    End With
    'ActiveSheet.Shapes("CommandButton1").Select
    ActiveSheet.Shapes.Range(Array("CommandButton1", "CommandButton2")).Select
    Selection.Delete
End Sub
Mục đích là khi tạo 1 sổ cái mới là tôi copy sang 1 sh khác và đặt tên sh theo SoTK
Nhưng khi tạo được 27 sh mới thì nó lại báo lỗi.
Do tôi duyệt từ
for iSoTK=1 to SoTK
Khi iSoTK=28 thì báo lỗi.
Lần 2 tôi cho chạy
for iSoTK=28 to SoTK
Khi iSoTK=55 thì báo lỗi.
Nghĩa là chỉ cho copy có 27 sh.
Lỗi như sau
Nhờ các bạn giúp đỡ.
Cám ơn nhiều!
Nhấp chuột vào đây để mở rộng...
Hình như giống tình trạng của thầy Hướng:
http://www.giaiphapexcel.com/forum/showthread.php?t=8951
 
Dùng cách 100 sh và lưu lại thì không pro lắm. Chắc tạo 1 sh 1 file trong folder.
Cám ơn ndu. Nghiên cứu tiếp giúp.
 
PHP: 
Private Function SheetExists(shName) As Boolean
Dim x As Object
On Error Resume Next
Set x = ActiveWorkbook.Sheets(shName)
If Err = 0 Then SheetExists = True _
Else SheetExists = False
End Function

Em thấy Code này nó có 2 vấn đề sau: Tại ... = True lại có thêm cái gạch nối "_", thứ 2 hàm này thiếu End If
Lẽ ra phải như vầy:
If Err = 0 Then
SheetExists = True
Else
SheetExists = False
End if

 
Lần chỉnh sửa cuối:
minhthien321 đã viết:
PHP: 
[COLOR=#000000][FONT=Courier New][COLOR=#007700]Private Function [/COLOR][COLOR=#0000bb]SheetExists[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]shName[/COLOR][COLOR=#007700]) As [/COLOR][/FONT][FONT=Courier New][COLOR=#0000bb]Boolean
    Dim x [/COLOR][COLOR=#007700]As [/COLOR][/FONT][FONT=Courier New][COLOR=#0000bb]Object
    On Error Resume Next
    Set x [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]ActiveWorkbook[/COLOR][COLOR=#007700].[/COLOR][COLOR=#0000bb]Sheets[/COLOR][COLOR=#007700]([/COLOR][COLOR=#0000bb]shName[/COLOR][/FONT][FONT=Courier New][COLOR=#007700])
    If [/COLOR][COLOR=#0000bb]Err [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]0 Then SheetExists [/COLOR][COLOR=#007700]= [/COLOR][/FONT][FONT=Courier New][COLOR=#0000bb]True _
        [/COLOR][COLOR=#007700]Else [/COLOR][COLOR=#0000bb]SheetExists [/COLOR][COLOR=#007700]= [/COLOR][/FONT][COLOR=#0000bb][FONT=Courier New]False
End [/FONT][/COLOR][COLOR=#007700][FONT=Courier New]Function[/FONT]
[/pup][/COLOR][/COLOR]
 
[COLOR=#000000][COLOR=#007700]Em thấy Code này nó có 2 vấn đề sau: Tại ... = True lại có thêm cái gạch nối [COLOR=red]"_"[/COLOR], thứ 2 hàm này thiếu [COLOR=red]End If[/COLOR]
[FONT=Courier New] If [COLOR=#0000bb]Err [/COLOR][COLOR=#007700]= [/COLOR][COLOR=#0000bb]0 Then SheetExists [/COLOR][COLOR=#007700]= [/COLOR][/FONT][FONT=Courier New][COLOR=#0000bb]True[COLOR=red] _
[/COLOR]        [/COLOR][COLOR=#007700]Else [/COLOR][COLOR=#0000bb]SheetExists [/COLOR][COLOR=#007700]= [/COLOR][/FONT][COLOR=#0000bb][FONT=Courier New]False
End [/FONT][/COLOR][COLOR=#007700][FONT=Courier New]Function[/FONT]
[/COLOR]
[/COLOR][/COLOR][/QUOTE]
cái vụ test sh có chưa này không quan trọng lắm. Chắc là sai chính tả thôi. Còn cú pháp là OK rồi. Nếu không nó sẽ không chạy code.
Nhấp chuột vào đây để mở rộng...
 
Em thấy Code này nó cứ xóa rồi rồi đặt tên rồi lại xóa, chứ nó có tạo ra sheet SoTK(n) nào đâu hả anh Thu Nghi?
PHP: 
Sub CopySheet()
Application.DisplayAlerts = False
    Sheets("SoCai").Copy After:=Sheets("SoCai")
    If SheetExists("SoTK") Then
      Sheets("SoTK").Delete
      ActiveSheet.Name = "SoTK"
    Else
      ActiveSheet.Name = "SoTK"
    End If
'XoaLinhTinh
    Sheets("SoCai").Select
    Application.DisplayAlerts = True
End Sub
 

Private Function SheetExists(shName) As Boolean
    Dim x As Object
    'On Error Resume Next
Set x = ActiveWorkbook.Sheets(shName)
If Err = 0 Then
SheetExists = True
Else
SheetExists = False
End If
End Function
 
To Minh Thien 321:
Em thấy Code này nó có 2 vấn đề sau: Tại ... = True lại có thêm cái gạch nối "_", thứ 2 hàm này thiếu End If
 If Err = 0 Then SheetExists = True _
 Else SheetExists = False
Nhấp chuột vào đây để mở rộng...

Cú pháp của câu lênh trên là đúng đấy. Dấu nối để đưa 2 đoạn code thành 1 dòng. Mà lệnh if trên 1 dòng không có End If
 
sealand đã viết:
To Minh Thien 321:

[/FONT]Cú pháp của câu lênh trên là đúng đấy. Dấu nối để đưa 2 đoạn code thành 1 dòng. Mà lệnh if trên 1 dòng không có End If
[/FONT][/COLOR][/COLOR]
Nhấp chuột vào đây để mở rộng...

Trời, em ABC quá, nên cứ trình tự mà làm. Vậy thì có thể viết đoạn Code như thế này phải không Anh Sealand?
If .......... Then ........... Else ................. (bỏ End If)
Nếu không có Else, thì viết như thế này có được không?
If .......... Then ........... (bỏ End If)
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

Mr.hieudoanxd
  • Question Question
[Cần hướng dẫn] Về lập trình Viết Function với Settimer và Killtimer
    • Thích
Trả lời
2
Đọc
55
Mr.hieudoanxd
Mr.hieudoanxd
bachloc1212
Đưa Text từ các dòng khác nhau về chung 1 dòng
Trả lời
10
Đọc
162
VetMini
V
D
Giúp đỡ thống kê dữ liệu theo điều kiện
Trả lời
6
Đọc
114
Duy Tùng 9x
Duy Tùng 9x
N
Sửa lỗi code vba khi chạy cho ra kết quả không đúng
Trả lời
6
Đọc
126
VetMini
V
Ha Manh-LD
  • Question Question
Lấy dữ liệu từ file csv
Trả lời
1
Đọc
83
ptm0412
ptm0412
T
Nhờ hỗ trợ hàm SUMIF không phân biệt được các ký tự "0" trước một số trong chuỗi
Trả lời
2
Đọc
98
VetMini
V
LuuAnh980
Add in tạo QR code miễn phí.
Trả lời
13
Đọc
389
LuuAnh980
LuuAnh980
HeSanbi
  • Đã giải quyết
VBA Nâng cao: Hướng dẫn tạo biểu thức tìm kiếm với Regular Expression
    • Thích
    • Yêu thích
Trả lời
9
Đọc
824
HeSanbi
HeSanbi
Tienvinh191
  • Question Question
Nhờ viết Code lấy dữ liệu tờ khai hải quan vào bảng tổng hợp
2
Trả lời
28
Đọc
2K
quyenpv
quyenpv
F
Hiển thị text trong Gantt chart (Google sheets)
Trả lời
0
Đọc
43
FATA11
F
Maika8008
  • Đã giải quyết
[Chia sẻ] Dùng VBA trộn dữ liệu Excel sang file Word mẫu (tương tự chức năng Mail Merge)
    • Thích
    • Yêu thích
    • Cảm ơn
25 26 27
Trả lời
522
Đọc
50K
Manhhung90
Manhhung90
C
Trách nhiệm pháp lý của chi nhánh doanh nghiệp Việt Nam tại nước ngoài với Công ty tại Việt Nam
Trả lời
5
Đọc
208
VetMini
V
C
  • Question Question
import data từ excel lên google sheet
Trả lời
5
Đọc
611
SonBDND
S
ptm0412
Chúc mừng năm mới Ất Tỵ 2025
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
1
Đọc
130
ptm0412
ptm0412
T
Bảng tính trợ cấp tinh giản biên chế theo NĐ 108
    • Thích
Trả lời
2
Đọc
946
thopd
T
mucongnghenhat
lỗi đoạn văn bản bị đóng khung
Trả lời
2
Đọc
120
VetMini
V
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
14 15 16
Trả lời
307
Đọc
22K
kunkoi9390
K
GPE-Trợ Lý
[GPE] TALK SHOW HÀM QUERY - BÍ KÍP BIẾN DỮ LIỆU KHỔNG LỒ THÀNH THÔNG TIN HỮU ÍCH TRONG TÍCH TẮC
    • Thích
    • Yêu thích
Trả lời
6
Đọc
2K
tranhungdao12a3
T
huuthang_bd
Add-in DeleteVirusMacro - Xóa và ngăn chặn virus macro
    • Thích
    • Yêu thích
    • Chấp nhận
2 3
Trả lời
45
Đọc
14K
ngocthu90
ngocthu90
Uyên dương Hoya
Lỗi định dạng font chữ trong excel
Trả lời
3
Đọc
143
ptm0412
ptm0412
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
Chúc mừng năm mới Ất Tỵ 2025
Back
Top Bottom