Giúp đỡ thêm sheet từ mẫu chưa có trong danh sách

[NGOCTOAN]

Chào các Anh/Chị,
Em đang làm file theo dõi vay theo file kèm nhưng muốn chèn thêm sheet khế ước mới A01, A02 từ cột A của sheet TH_VAY_TRA và dc copy mãu từ sheet TEMP mà không được, ko biết sai chỗ nào? không thêm mới được. Mong các Anh/Chị hỗ trợ.
Trân trọng cảm ơn!
Ngoctoan.

Sub Tao_KU_chua_trongDS() 'tao cac KU moi chua co trong ds KU
    Application.Calculation = xlManual
    Dim dv As String, i, k As Integer
    Dim sh As Worksheet
    Application.ScreenUpdating = False
    On Error Resume Next
    For i = 2 To Sheet1.[A65536].End(xlUp).Row 'So dong cuoi cung cot A
    dv = Sheet1.Range("A" & i) 'Gia tri dong thu i cot A
        For k = 1 To Sheets.Count
            If Sheets.Item(k).Name = "TH_VAY_TRA" Or Sheets.Item(k).Name = "TEMP" Or Sheets.Item(k).Name = "PS_TRA" Then
              k = k + 1
              Else
                  If Len(dv) > 0 And Sheets.Item(k).Name <> dv Then
                  Sheets("TEMP").Copy After:=Sheets(Sheets.Count) 'tao Copy tu sheet Temp
                  ActiveSheet.Name = dv 'Doi ten Sheet vua copy gán = gia tri cuoi cot A=so KU
                  Application.StatusBar = dv
                  With Sheets(dv)
                        .[A2] = dv 'gan so KU tai A2 cua sheet moi tao
                        .[B2] = Sheet1.Range("B" & i) ' gan so ngay giai ngan
                        .[C2] = Sheet1.Range("C" & i) 'gan lai suat
                        .[D2] = Sheet1.Range("G" & i) ' Gan so tien giai ngan
                     
                  End With
             End If
     Application.StatusBar = ""
    Sheet1.ShowAllData
    Sheet1.Activate
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & i), Address:="", SubAddress:= _
        "'" & dv & "'!A1", TextToDisplay:=dv
          End If
        Next
    Next
   
        MsgBox "Xong"
End Sub

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

 

[befaint]

sai chỗ nào

Bỏ dòng này

On Error Resume Next

rồi bạn chụp hình lúc lỗi gửi lên đây.

 

[NGOCTOAN]

Bỏ dòng này

On Error Resume Next

rồi bạn chụp hình lúc lỗi gửi lên đây.

Dạ nó chạy cái vèo ok không chèn thêm 2 KU là A1; A2..chưa có sheet nào trong wb, mình sửa tới lui mà ko dc, Anh xem có phải sai giải thuật gì ko ạ

 

[HieuCD]

Chào các Anh/Chị,
Em đang làm file theo dõi vay theo file kèm nhưng muốn chèn thêm sheet khế ước mới A01, A02 từ cột A của sheet TH_VAY_TRA và dc copy mãu từ sheet TEMP mà không được, ko biết sai chỗ nào? không thêm mới được. Mong các Anh/Chị hỗ trợ.
Trân trọng cảm ơn!
Ngoctoan.

Sub Tao_KU_chua_trongDS() 'tao cac KU moi chua co trong ds KU
    Application.Calculation = xlManual
    Dim dv As String, i, k As Integer
    Dim sh As Worksheet
    Application.ScreenUpdating = False
    On Error Resume Next
    For i = 2 To Sheet1.[A65536].End(xlUp).Row 'So dong cuoi cung cot A
    dv = Sheet1.Range("A" & i) 'Gia tri dong thu i cot A
        For k = 1 To Sheets.Count
            If Sheets.Item(k).Name = "TH_VAY_TRA" Or Sheets.Item(k).Name = "TEMP" Or Sheets.Item(k).Name = "PS_TRA" Then
              k = k + 1
              Else
                  If Len(dv) > 0 And Sheets.Item(k).Name <> dv Then
                  Sheets("TEMP").Copy After:=Sheets(Sheets.Count) 'tao Copy tu sheet Temp
                  ActiveSheet.Name = dv 'Doi ten Sheet vua copy gán = gia tri cuoi cot A=so KU
                  Application.StatusBar = dv
                  With Sheets(dv)
                        .[A2] = dv 'gan so KU tai A2 cua sheet moi tao
                        .[B2] = Sheet1.Range("B" & i) ' gan so ngay giai ngan
                        .[C2] = Sheet1.Range("C" & i) 'gan lai suat
                        .[D2] = Sheet1.Range("G" & i) ' Gan so tien giai ngan
                    
                  End With
             End If
     Application.StatusBar = ""
    Sheet1.ShowAllData
    Sheet1.Activate
    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A" & i), Address:="", SubAddress:= _
        "'" & dv & "'!A1", TextToDisplay:=dv
          End If
        Next
    Next
  
        MsgBox "Xong"
End Sub

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

Bỏ dòng lệnh
k = k + 1

 

[NGOCTOAN]

Bỏ dòng lệnh
k = k + 1

Bỏ K=k+1 đi thì nó chèn rất nhiều Sheet TEMP(1)...TEMP(n).

 

[NGOCTOAN]

Bỏ dòng lệnh
k = k + 1

Em nghĩ nó sai ở chỗ vòng For thứ 2 : For k = 1 To Sheets.Count để kiểm tra sheet nào trùng với 3 sheet ko dc thay đổi là TH_VAY_TRA; TEMP; PS_TRA, nhưng nếu ko thỏa đk trên thì mệnh đề ESLE nó kiểm tra các sheet KU nào đã có mà không trùng với cell gán = dv thì nó chèn thêm copy thêm sheet từ Temp, như vậy For k = 1 To Sheets.Count nó tính sai. Em chưa nghĩ cách nào để hoàn thiện code trên, nhờ Anh hỗ trợ. Xin Cảm ơn!

 

[HieuCD]

Em nghĩ nó sai ở chỗ vòng For thứ 2 : For k = 1 To Sheets.Count để kiểm tra sheet nào trùng với 3 sheet ko dc thay đổi là TH_VAY_TRA; TEMP; PS_TRA, nhưng nếu ko thỏa đk trên thì mệnh đề ESLE nó kiểm tra các sheet KU nào đã có mà không trùng với cell gán = dv thì nó chèn thêm copy thêm sheet từ Temp, như vậy For k = 1 To Sheets.Count nó tính sai. Em chưa nghĩ cách nào để hoàn thiện code trên, nhờ Anh hỗ trợ. Xin Cảm ơn!

Tự thêm lệnh cần thiết

Sub Tao_KU_chua_trongDS() 'tao cac KU moi chua co trong ds KU
  Dim So_KU As String, i As Long, k As Long, eRow As Long
 
  eRow = Sheet1.[A65536].End(xlUp).Row
  For i = 2 To eRow 'So dong cuoi cung cot A
    So_KU = Sheet1.Range("A" & i) 'Gia tri dong thu i cot A
    If Len(So_KU) > 0 Then
      For k = 1 To Sheets.Count
        If Sheets.Item(k).Name = So_KU Then Exit For
      Next k
      If k = 1 + Sheets.Count Then 'Sheet So_KU chua co, them sheet So_KU
        Sheets("TEMP").Copy After:=Sheets(Sheets.Count) 'tao Copy tu sheet Temp
        With Sheets(Sheets.Count)
          .Name = So_KU 'Doi ten Sheet
          .[A2] = dv 'gan so KU tai A2 cua sheet moi tao
          .[B2] = Sheet1.Range("B" & i) ' gan so ngay giai ngan
          .[C2] = Sheet1.Range("C" & i) 'gan lai suat
          .[D2] = Sheet1.Range("G" & i) ' Gan so tien giai ngan
        End With
      End If
    End If
  Next i
  Sheet1.Select
  MsgBox "Xong"
End Sub

 

[tigertiger]

Em nghĩ nó sai ở chỗ vòng For thứ 2 : For k = 1 To Sheets.Count để kiểm tra sheet nào trùng với 3 sheet ko dc thay đổi là TH_VAY_TRA; TEMP; PS_TRA, nhưng nếu ko thỏa đk trên thì mệnh đề ESLE nó kiểm tra các sheet KU nào đã có mà không trùng với cell gán = dv thì nó chèn thêm copy thêm sheet từ Temp, như vậy For k = 1 To Sheets.Count nó tính sai. Em chưa nghĩ cách nào để hoàn thiện code trên, nhờ Anh hỗ trợ. Xin Cảm ơn!

Thuật toán đang sai
Sao kiểm tra
Sheets.Item(k)
trùng với 1 trong 3 cái TH_VAY_TRA; TEMP; PS_TRA làm gì??? là sao?

Cứ cộng thêm vào tên không trùng là được mới thôi, không hiểu bạn dùng vòng lặp k đó làm gì?

 

[NGOCTOAN]

Tự thêm lệnh cần thiết

Sub Tao_KU_chua_trongDS() 'tao cac KU moi chua co trong ds KU
  Dim So_KU As String, i As Long, k As Long, eRow As Long

  eRow = Sheet1.[A65536].End(xlUp).Row
  For i = 2 To eRow 'So dong cuoi cung cot A
    So_KU = Sheet1.Range("A" & i) 'Gia tri dong thu i cot A
    If Len(So_KU) > 0 Then
      For k = 1 To Sheets.Count
        If Sheets.Item(k).Name = So_KU Then Exit For
      Next k
      If k = 1 + Sheets.Count Then 'Sheet So_KU chua co, them sheet So_KU
        Sheets("TEMP").Copy After:=Sheets(Sheets.Count) 'tao Copy tu sheet Temp
        With Sheets(Sheets.Count)
          .Name = So_KU 'Doi ten Sheet
          .[A2] = dv 'gan so KU tai A2 cua sheet moi tao
          .[B2] = Sheet1.Range("B" & i) ' gan so ngay giai ngan
          .[C2] = Sheet1.Range("C" & i) 'gan lai suat
          .[D2] = Sheet1.Range("G" & i) ' Gan so tien giai ngan
        End With
      End If
    End If
  Next i
  Sheet1.Select
  MsgBox "Xong"
End Sub

Cảm ơn Bác Hieu_CD, em sửa lại đôi chỗ đúng rồi, nhưng em chưa hiểu : If k = 1 + Sheets.Count Bác có giải thích thêm chỗ sau vòng lặp For k dc ko ạ.

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

Thuật toán đang sai
Sao kiểm tra
Sheets.Item(k)
trùng với 1 trong 3 cái TH_VAY_TRA; TEMP; PS_TRA làm gì??? là sao?

Cứ cộng thêm vào tên không trùng là được mới thôi, không hiểu bạn dùng vòng lặp k đó làm gì?

Cảm ơn Bác, mục đích là ko trùng 3 Sheet kia được, nếu trùng ko thêm gì cả. Đúng là thuật toán sai, sau khi chỉnh Code bác Hieu_CD thì ok rồi,

 

[HieuCD]

Cảm ơn Bác Hieu_CD, em sửa lại đôi chỗ đúng rồi, nhưng em chưa hiểu : If k = 1 + Sheets.Count Bác có giải thích thêm chỗ sau vòng lặp For k dc ko ạ.

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

Cảm ơn Bác, mục đích là ko trùng 3 Sheet kia được, nếu trùng ko thêm gì cả. Đúng là thuật toán sai, sau khi chỉnh Code bác Hieu_CD thì ok rồi,

Vòng lập
For k = 1 To Sheets.Count
If Sheets.Item(k).Name = So_KU Then Exit For
Next k
Lệnh
If Sheets.Item(k).Name = So_KU Then Exit For
Nếu sheet So_KU tồn tại thoát vòng lập lúc đó K<= Sheets.Count
Nếu sheet So_KU chưa có, vòng lập k chạy đến Sheets.Count +1 > Sheets.Count sẽ thoát khỏi vòng lập nên k = Sheets.Count +1
Lệnh xét Sheet So_KU chưa có
If k = 1 + Sheets.Count Then 'Sheet So_KU chua co, thêm sheet So_KU

 

[NGOCTOAN]

Vòng lập
For k = 1 To Sheets.Count
If Sheets.Item(k).Name = So_KU Then Exit For
Next k
Lệnh
If Sheets.Item(k).Name = So_KU Then Exit For
Nếu sheet So_KU tồn tại thoát vòng lập lúc đó K<= Sheets.Count
Nếu sheet So_KU chưa có, vòng lập k chạy đến Sheets.Count +1 > Sheets.Count sẽ thoát khỏi vòng lập nên k = Sheets.Count +1
Lệnh xét Sheet So_KU chưa có
If k = 1 + Sheets.Count Then 'Sheet So_KU chua co, thêm sheet So_KU

Vâng, cảm ơn bác rất nhiều!! Trước khi tham khảo trợ giúp rất đúng và ngắn của Bác thì em đã làm được rồi nhưng đưa vào danh sách chuối và code dài hơn :
For k = 4 To n
nsh = nsh + Sheets.Item(k).Name + "," 'tao 1chuoi chua cac sheet hien hanh cach nhau 1 dau phay
Next
Rồi mới dùng Instr để tìm xem So_KU có trng Nsh ko, nếu ko mới chèn thêm, nhưng nó dài dòng quá! Nhưng code của Bác ngắn mà trừu tượng hơn khó hình dung sau khi có sự giải thích của Bác như trên.