Nhờ chỉnh sữa code copy tù1 1 sheet ra nhiều sheet

Liên hệ QC
Hoangkhang01213

Hoangkhang01213

Thành viên mới
Tham gia
9/6/18
Bài viết
30
Được thích
0
Chào mọi người mình có một vấn đề không biết làm sau nhờ mọi người hổ trợ với, mình có một file mẫu có 2 sheet "data1" và BT(28)
1. Trong file có một code VBA copy sheet và số lượng sheet cần copy do mình chọn lệnh tắt Ctrl+shift+H để mở hợp thoại,
mình muốn nhờ các bạn sửa code giúp mình là khi copy ra thì cũng đồng thời đánh số thứ tự các sheet vừa copy ra(kể cả sheet nguồn) và số thứ tự đó được đánh tại các ô P1 của các sheet.

2. Mục đích là để mình có thể dựa vào số thứ tự đó kết hợp hàm VLOOKUP để dò tìm ký hiệu mẫu từ sheet đa ta nếu các bạn có ý hay hơn nhờ các bạn tư vấn giúp minh
em xĩn cảm ơn các bạn
trước
 

File đính kèm

linh123456abcd đã viết:
Chào mọi người mình có một vấn đề không biết làm sau nhờ mọi người hổ trợ với, mình có một file mẫu có 2 sheet "data1" và BT(28)
1. Trong file có một code VBA copy sheet và số lượng sheet cần copy do mình chọn lệnh tắt Ctrl+shift+H để mở hợp thoại,
mình muốn nhờ các bạn sửa code giúp mình là khi copy ra thì cũng đồng thời đánh số thứ tự các sheet vừa copy ra(kể cả sheet nguồn) và số thứ tự đó được đánh tại các ô P1 của các sheet.

2. Mục đích là để mình có thể dựa vào số thứ tự đó kết hợp hàm VLOOKUP để dò tìm ký hiệu mẫu từ sheet đa ta nếu các bạn có ý hay hơn nhờ các bạn tư vấn giúp minh
em xĩn cảm ơn các bạn
trước
Nhấp chuột vào đây để mở rộng...
Bạn có chắc là số thứ tự gán vào ô P1 không?
※　Hiện tại đang gán vào ô A1。
 
linh123456abcd đã viết:
dạ số thứ tự thì gắn vào ô P1 ạ lý do sheet ddata1 đó khi chọn copy em sẽ không chọn sheet nguồn là sheet data1, bởi lý do là ô Z1 trong sheet BT28 đang tham chiếu vào đó ạ
Nhấp chuột vào đây để mở rộng...
Tôi chưa kiểm tra hết các trường hợp, bạn thử code dưới xem được chưa?!
Mã: 
Private Sub CommandButton1_Click()
Dim i As Byte, ShCuoi As Byte, shc&
On Error Resume Next
    ShCuoi = IIf(WorksheetFunction.IsNumber(Val(Sheets(Sheets.Count).Name)), Val(Sheets(Sheets.Count).Name), 0)
    For i = 1 To ScrollBar1.Value
        Sheets(ComboBox1.Value).Copy After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = ShCuoi + i
        Sheets(Sheets.Count).[P1] = ShCuoi + i
    Next i
    shc = IIf(WorksheetFunction.IsNumber(Val(Sheets(Sheets.Count).Name)), Val(Sheets(Sheets.Count).Name), 0)
    Sheets(ComboBox1.Value).Name = shc + 1
    Unload Me
End Sub
 
THÓC SAMA đã viết:
Tôi chưa kiểm tra hết các trường hợp, bạn thử code dưới xem được chưa?!
Mã: 
Private Sub CommandButton1_Click()
Dim i As Byte, ShCuoi As Byte, shc&
On Error Resume Next
    ShCuoi = IIf(WorksheetFunction.IsNumber(Val(Sheets(Sheets.Count).Name)), Val(Sheets(Sheets.Count).Name), 0)
    For i = 1 To ScrollBar1.Value
        Sheets(ComboBox1.Value).Copy After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = ShCuoi + i
        Sheets(Sheets.Count).[P1] = ShCuoi + i
    Next i
    shc = IIf(WorksheetFunction.IsNumber(Val(Sheets(Sheets.Count).Name)), Val(Sheets(Sheets.Count).Name), 0)
    Sheets(ComboBox1.Value).Name = shc + 1
    Unload Me
End Sub
Nhấp chuột vào đây để mở rộng...
code chạy rất đúng nhu cầu ạ em cảm ơn rất nhiều
 
Lần chỉnh sửa cuối:
linh123456abcd đã viết:
code chạy rất đúng nhu cầu ạ em cảm ơn rất nhiều
nhưng mà a có thể chỉnh chút xíu nửa là kiểu như sheet nguồn tên là "BT" thì các sheet được copy ra sẽ là BT 1, BT 2, Bt3, ..., được không như vậy đở nhầm hơn nếu như khaonr thời gian sau cần copy ra thêm thì đở rối
Nhấp chuột vào đây để mở rộng...
linh123456abcd đã viết:
code chạy rất đúng nhu cầu ạ em cảm ơn rất nhiều
Nhấp chuột vào đây để mở rộng...
Nhưng mà a có thể chỉnh chút xíu nửa là kiểu như sheet nguồn tên là "BT" thì các sheet được copy ra sẽ là BT 1, BT 2, Bt3, ..., được không như vậy đở nhầm hơn nếu như khaonr thời gian sau cần copy ra thêm thì đở rối
 
linh123456abcd đã viết:
Nhưng mà a có thể chỉnh chút xíu nửa là kiểu như sheet nguồn tên là "BT" thì các sheet được copy ra sẽ là BT 1, BT 2, Bt3, ..., được không như vậy đở nhầm hơn nếu như khaonr thời gian sau cần copy ra thêm thì đở rối
Nhấp chuột vào đây để mở rộng...
Sửa lại một chút như thế này
Mã: 
Private Sub CommandButton1_Click()
Dim i As Byte, ShCuoi As Byte, shc&, ii&
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Left(ComboBox1.Value, 2) = "BT" Then
    For ii = 1 To ScrollBar1.Value
        Sheets(ComboBox1.Value).Copy After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = "BT " & ShCuoi + ii
        Sheets(Sheets.Count).[P1] = "BT " & ShCuoi + ii
    Next ii
Else
    ShCuoi = IIf(WorksheetFunction.IsNumber(Val(Sheets(Sheets.Count).Name)), Val(Sheets(Sheets.Count).Name), 0)
    For i = 1 To ScrollBar1.Value
        Sheets(ComboBox1.Value).Copy After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = ShCuoi + i
        Sheets(Sheets.Count).[P1] = ShCuoi + i
    Next i
    shc = IIf(WorksheetFunction.IsNumber(Val(Sheets(Sheets.Count).Name)), Val(Sheets(Sheets.Count).Name), 0)
    Sheets(ComboBox1.Value).Name = shc + 1
End If
    Unload Me
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
 
THÓC SAMA đã viết:
Sửa lại một chút như thế này
Mã: 
Private Sub CommandButton1_Click()
Dim i As Byte, ShCuoi As Byte, shc&, ii&
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Left(ComboBox1.Value, 2) = "BT" Then
    For ii = 1 To ScrollBar1.Value
        Sheets(ComboBox1.Value).Copy After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = "BT " & ShCuoi + ii
        Sheets(Sheets.Count).[P1] = "BT " & ShCuoi + ii
    Next ii
Else
    ShCuoi = IIf(WorksheetFunction.IsNumber(Val(Sheets(Sheets.Count).Name)), Val(Sheets(Sheets.Count).Name), 0)
    For i = 1 To ScrollBar1.Value
        Sheets(ComboBox1.Value).Copy After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = ShCuoi + i
        Sheets(Sheets.Count).[P1] = ShCuoi + i
    Next i
    shc = IIf(WorksheetFunction.IsNumber(Val(Sheets(Sheets.Count).Name)), Val(Sheets(Sheets.Count).Name), 0)
    Sheets(ComboBox1.Value).Name = shc + 1
End If
    Unload Me
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Nhấp chuột vào đây để mở rộng...
Code đã đúng như nhu cầu rồi ạ cảm ơn anh đã hổ trợ em rất nhiệt tình
 
THÓC SAMA đã viết:
Sửa lại một chút như thế này
Mã: 
Private Sub CommandButton1_Click()
Dim i As Byte, ShCuoi As Byte, shc&, ii&
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Left(ComboBox1.Value, 2) = "BT" Then
    For ii = 1 To ScrollBar1.Value
        Sheets(ComboBox1.Value).Copy After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = "BT " & ShCuoi + ii
        Sheets(Sheets.Count).[P1] = "BT " & ShCuoi + ii
    Next ii
Else
    ShCuoi = IIf(WorksheetFunction.IsNumber(Val(Sheets(Sheets.Count).Name)), Val(Sheets(Sheets.Count).Name), 0)
    For i = 1 To ScrollBar1.Value
        Sheets(ComboBox1.Value).Copy After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = ShCuoi + i
        Sheets(Sheets.Count).[P1] = ShCuoi + i
    Next i
    shc = IIf(WorksheetFunction.IsNumber(Val(Sheets(Sheets.Count).Name)), Val(Sheets(Sheets.Count).Name), 0)
    Sheets(ComboBox1.Value).Name = shc + 1
End If
    Unload Me
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn THÓC rất chịu khó chứ he. Tôi mà thấy yêu cầu ẩu ẩu thế này là có ý kiến liền: BT 1, BT 2, Bt3
Cứ suy luận logic thì cứ sau 2 cái BT với chỉ số viết rời 1 dấu cách, thì sẽ có 1 Bt (t viết thường) đánh số dính liền?
 
Maika8008 đã viết:
Tôi mà thấy yêu cầu ẩu ẩu thế này là có ý kiến liền: BT 1, BT 2, Bt3
Cứ suy luận logic thì cứ sau 2 cái BT với chỉ số viết rời 1 dấu cách, thì sẽ có 1 Bt (t viết thường) đánh số dính liền?
Nhấp chuột vào đây để mở rộng...
-0-0-0-
Đúng logic của người viết code bác hả?
Em đang "quởn" nên vừa làm, vừa đoán ý thớt!
 
Maika8008 đã viết:
Bạn THÓC rất chịu khó chứ he. Tôi mà thấy yêu cầu ẩu ẩu thế này là có ý kiến liền: BT 1, BT 2, Bt3
Cứ suy luận logic thì cứ sau 2 cái BT với chỉ số viết rời 1 dấu cách, thì sẽ có 1 Bt (t viết thường) đánh số dính liền?
Nhấp chuột vào đây để mở rộng...
Cở này bị kiểm toán dí quá nên xem chưa có kỹ sẽ để ý hơn cho những lần sau cảm ơn bạn đã góp ý
 
Maika8008 đã viết:
Bạn THÓC rất chịu khó chứ he. Tôi mà thấy yêu cầu ẩu ẩu thế này là có ý kiến liền: BT 1, BT 2, Bt3
Cứ suy luận logic thì cứ sau 2 cái BT với chỉ số viết rời 1 dấu cách, thì sẽ có 1 Bt (t viết thường) đánh số dính liền?
Nhấp chuột vào đây để mở rộng...
Người ta được đãi bánh trái trước bạn ơi. Cứ khen đúng trước rồi yêu cầu chỉnh sửa sau. Dẫu bánh vẽ nhưng người trong cuộc khó nhận ra.

linh123456abcd đã viết:
code chạy rất đúng nhu cầu ạ em cảm ơn rất nhiều
Nhấp chuột vào đây để mở rộng...
linh123456abcd đã viết:
Nhưng mà a có thể chỉnh chút xíu nửa là kiểu như sheet nguồn tên là "BT" thì các sheet được copy ra sẽ là BT 1, BT 2, Bt3, ..., được không như vậy đở nhầm hơn nếu như khaonr thời gian sau cần copy ra thêm thì đở rối
Nhấp chuột vào đây để mở rộng...
 
THÓC SAMA đã viết:
Sửa lại một chút như thế này
Mã: 
Private Sub CommandButton1_Click()
Dim i As Byte, ShCuoi As Byte, shc&, ii&
On Error Resume Next
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If Left(ComboBox1.Value, 2) = "BT" Then
    For ii = 1 To ScrollBar1.Value
        Sheets(ComboBox1.Value).Copy After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = "BT " & ShCuoi + ii
        Sheets(Sheets.Count).[P1] = "BT " & ShCuoi + ii
    Next ii
Else
    ShCuoi = IIf(WorksheetFunction.IsNumber(Val(Sheets(Sheets.Count).Name)), Val(Sheets(Sheets.Count).Name), 0)
    For i = 1 To ScrollBar1.Value
        Sheets(ComboBox1.Value).Copy After:=Sheets(Sheets.Count)
        Sheets(Sheets.Count).Name = ShCuoi + i
        Sheets(Sheets.Count).[P1] = ShCuoi + i
    Next i
    shc = IIf(WorksheetFunction.IsNumber(Val(Sheets(Sheets.Count).Name)), Val(Sheets(Sheets.Count).Name), 0)
    Sheets(ComboBox1.Value).Name = shc + 1
End If
    Unload Me
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Nhấp chuột vào đây để mở rộng...
mà anh ơi trong quá trình sử dụng em thấy thế này khi em copy lần thứ nhất VD: copy ra 3 sheet song code đếm thứ tự từ 1 đến 3 ở ô P1, nhưng khi em sửa tên sheet nguồn hoặc em copy ra thêm vài sheet nửa thì code không đếm tiếp mà lại đếm lại từ đầu, anh chỉnh giúp em cho nó tiếp tục đếm lênh khi mình copy tiếp không anh hoặc là cho cái chổ để người dùng nhập số bắt đầu đếm tiếp không anh, nhờ anh chỉnh giúp em cảm ơn trước
 
linh123456abcd đã viết:
mà anh ơi trong quá trình sử dụng em thấy thế này khi em copy lần thứ nhất VD: copy ra 3 sheet song code đếm thứ tự từ 1 đến 3 ở ô P1, nhưng khi em sửa tên sheet nguồn hoặc em copy ra thêm vài sheet nửa thì code không đếm tiếp mà lại đếm lại từ đầu, anh chỉnh giúp em cho nó tiếp tục đếm lênh khi mình copy tiếp không anh hoặc là cho cái chổ để người dùng nhập số bắt đầu đếm tiếp không anh, nhờ anh chỉnh giúp em cảm ơn trước
Nhấp chuột vào đây để mở rộng...
Không biết đã đúng ý bạn chưa
Kiểm tra lại xem sao nhé!
[Ấn Ctrl+J để Copy Sheet]
Mã: 
Option Explicit
Private Sub UserForm_Initialize()
Dim i As Integer, Arr(), k As Integer
ReDim Arr(1 To Sheets.Count, 1 To 1)
For i = 1 To Sheets.Count
    k = k + 1
    Arr(k, 1) = Sheets(i).Name
Next i
Cbb1.List = Arr
End Sub
Private Sub CmdCancel_Click()
    Unload Me
End Sub
Private Sub CmdOK_Click()
Dim a As Integer, b As Integer, Ws As Worksheet
Dim c As Integer, z As Integer, k As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
c = Sheets.Count
a = Txt1
If a > 0 Then
    If Left(Cbb1.Value, 1) = "D" Then
        For b = 1 To a
            z = Sheets.Count
            Sheets(Cbb1.Value).Copy after:=Sheets(c)
            ActiveSheet.Name = "D" & z
        Next b
        For Each Ws In Worksheets
            If InStr(Ws.Name, "D") > 0 Then
                k = k + 1
                Ws.Name = "Data " & k
                Ws.Range("P1").Value = "Data " & k
            End If
        Next
        Unload Me
    ElseIf Left(Cbb1.Value, 2) = "BT" Then
        For b = 1 To a
            z = Sheets.Count
            Sheets(Cbb1.Value).Copy after:=Sheets(c)
            ActiveSheet.Name = "BT " & z
            ActiveSheet.Range("P1").Value = "BT " & z
        Next b
        For Each Ws In Worksheets
            If InStr(Ws.Name, "B") > 0 Then
                k = k + 1
                Ws.Name = "BT" & k
                Ws.Range("P1").Value = "BT " & k
            End If
        Next
        Unload Me
    End If
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
 

File đính kèm

THÓC SAMA đã viết:
Không biết đã đúng ý bạn chưa
Kiểm tra lại xem sao nhé!
[Ấn Ctrl+J để Copy Sheet]
Mã: 
Option Explicit
Private Sub UserForm_Initialize()
Dim i As Integer, Arr(), k As Integer
ReDim Arr(1 To Sheets.Count, 1 To 1)
For i = 1 To Sheets.Count
    k = k + 1
    Arr(k, 1) = Sheets(i).Name
Next i
Cbb1.List = Arr
End Sub
Private Sub CmdCancel_Click()
    Unload Me
End Sub
Private Sub CmdOK_Click()
Dim a As Integer, b As Integer, Ws As Worksheet
Dim c As Integer, z As Integer, k As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
c = Sheets.Count
a = Txt1
If a > 0 Then
    If Left(Cbb1.Value, 1) = "D" Then
        For b = 1 To a
            z = Sheets.Count
            Sheets(Cbb1.Value).Copy after:=Sheets(c)
            ActiveSheet.Name = "D" & z
        Next b
        For Each Ws In Worksheets
            If InStr(Ws.Name, "D") > 0 Then
                k = k + 1
                Ws.Name = "Data " & k
                Ws.Range("P1").Value = "Data " & k
            End If
        Next
        Unload Me
    ElseIf Left(Cbb1.Value, 2) = "BT" Then
        For b = 1 To a
            z = Sheets.Count
            Sheets(Cbb1.Value).Copy after:=Sheets(c)
            ActiveSheet.Name = "BT " & z
            ActiveSheet.Range("P1").Value = "BT " & z
        Next b
        For Each Ws In Worksheets
            If InStr(Ws.Name, "B") > 0 Then
                k = k + 1
                Ws.Name = "BT" & k
                Ws.Range("P1").Value = "BT " & k
            End If
        Next
        Unload Me
    End If
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Nhấp chuột vào đây để mở rộng...
Code chạy đúng như ý trên, nhưng tên sheet và số thứ tự đánh trên ô P1 bị ngược nhau anh ơi kiểu như sheet " BT 26 "thì tại ô P1 lại ghi là "BT 2" thay vì là "BT 26" với copy ra khoản 20 sheet thì thấy code chạy hơi chậm một chút anh có thể hiệu chỉnh giúp em được không ạ, em cảm ơn!
 
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

minhquipk
  • Question Question
Cách nhận biết những ô đã bị thay đổi giá trị khi thay đổi giá trị dữ liệu ở những ô khác
Trả lời
3
Đọc
64
le_vis
L
V
  • Question Question
Tách số liệu từ bảng tính ngang theo điều kiện
Trả lời
9
Đọc
206
HieuCD
H
P
Xin trợ giúp cách lập lịch trực tịnh tiến dần cho 1 nhóm người.
Trả lời
1
Đọc
44
hoangtuaotrang_hp_vn
H
HeSanbi
  • Đã giải quyết
LocalizeXL v1.72 - Làm nổi bật ô đang chọn và cuộn trang tự động
    • Thích
    • Yêu thích
2 3 4
Trả lời
63
Đọc
10K
125479980
125479980
H
Tìm kết quả trả về theo loại
Trả lời
9
Đọc
74
VetMini
V
LongHoang123
  • Question Question
Xin hướng dẫn: Cách tạo vùng in dựa trên dữ liệu của listbox bằng VBA!!!
Trả lời
4
Đọc
79
LongHoang123
LongHoang123
M
  • Question Question
"thủ tục để xóa dòng trống " trong Lập trình VBA trong Excel
2 3 4
Trả lời
63
Đọc
15K
SonBDND
S
Q
Hỏi về công thức dò giá
Trả lời
6
Đọc
181
thanthanhan0801
T
N
  • Question Question
VBA - copy các sheets unhide và dạng giá trị theo vùng xác định
Trả lời
6
Đọc
326
nguyenhuong34
nguyenhuong34
ThanhPhongDN
hỏi về cách thay đổi giá trị một ô sau khi nhập một giá trị vào đó
Trả lời
7
Đọc
138
vietduc147258
V
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
Trả lời
34
Đọc
13K
hungbon7890
hungbon7890
A
  • Question Question
code vba chuyển chuỗi thành text
Trả lời
11
Đọc
2K
SonBDND
S
V
Xin giúp em file theo dõi thanh toán có bị quá hạn không, quá bao nhiêu ngày và bao nhiêu tiền ạ
Trả lời
11
Đọc
308
HUONGHCKT
H
Tandattb
Xin cách Khắc phục lỗi "Path/File access error"
Trả lời
8
Đọc
287
Tandattb
Tandattb
ThanhPhongDN
Nhờ giúp đỡ về công thức trong google sheet
    • Cười
Trả lời
4
Đọc
85
thuytrangbp28
T
saobekhonglac
Tạo form vòng quay may mắn
    • Thích
2
Trả lời
35
Đọc
15K
VetMini
V
D
Thống kê dữ liệu theo điều kiện
Trả lời
5
Đọc
138
VetMini
V
noisy
Xin file tính chế độ chuyên cần
    • Cười
Trả lời
0
Đọc
46
noisy
noisy
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ
    • Cảm ơn
Trả lời
3
Đọc
715
hvnhpro
H
hanhlx88
Nhờ giúp file Excel báo lỗi: Excel cannot complete this task with available resources
Trả lời
2
Đọc
122
leonguyenz
leonguyenz
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.
Back
Top Bottom