Nhờ giúp em code vba tạo thêm 3 sheet mới có nội dung. (1 người xem)

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

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
X

xucxich

Thành viên mới
Tham gia
19/5/13
Bài viết
45
Được thích
5
Nhờ các thầy, các anh trên GPE giúp em code VBA như sau:
Lúc ban đầu file của e chỉ có sheet "Thong-Ke". khi em chạy code thì chương trình sẽ tự động tạo ra 3 sheet: "So-Lieu", "Ket-Qua(1)", "Ket-Qua(2)"
- Với 2 sheet "Ket-Qua(1)", "Ket-Qua(2)" thì nội dung như trong file đính kèm.
- Với sheet "So-Lieu" có nội dung như file đính kèm và đồng thời copy nội dung 4 cột ở bên sheet "Thong-Ke" qua (4 cột màu vàng bên sheet "Thong-Ke" sẽ copy qua các cột tương ứng bên sheet "So-Lieu")
Sau khi tạo xong 3 sheet thì con trỏ chuột ở vị trí ô F2 của sheet "Du-Lieu"

Em cảm ơn!
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
Nhờ các thầy, các anh trên GPE giúp em code VBA như sau:
(2) Lúc ban đầu file của e chỉ có sheet "Thong-Ke". khi em chạy code thì chương trình sẽ tự động tạo ra 3 sheet: "So-Lieu", "Ket-Qua(1)", "Ket-Qua(2)"
(2.0)- Với 2 sheet "Ket-Qua(1)", "Ket-Qua(2)" thì nội dung như trong file đính kèm.
(1) - Với sheet "So-Lieu" có nội dung như file đính kèm và đồng thời copy nội dung 4 cột ở bên sheet "Thong-Ke" qua (4 cột màu vàng bên sheet "Thong-Ke" sẽ copy qua các cột tương ứng bên sheet "So-Lieu")
(3) Sau khi tạo xong 3 sheet thì con trỏ chuột ở vị trí ô F2 của sheet "Du-Lieu"
Em cảm ơn!
Nhấp chuột vào đây để mở rộng...

(1) Ta chỉ việc tạo trang này 1 lần;
Những lần sau ta chỉ cần xóa đi dữ liệu sau dòng 8 là đạt iêu cầu đề ra;
Chuyện này không khó.

Vời (2) & (2.0): Thì cũng tương tự trên;

(3) Chuyện này cũng không khó lắm với VBA;

Cái khó là chưa chắc hiểu đúng í bạn;
 
Upvote 0
HYen17 đã viết:
(1) Ta chỉ việc tạo trang này 1 lần;
Những lần sau ta chỉ cần xóa đi dữ liệu sau dòng 8 là đạt iêu cầu đề ra;
Chuyện này không khó.

Vời (2) & (2.0): Thì cũng tương tự trên;

(3) Chuyện này cũng không khó lắm với VBA;

Cái khó là chưa chắc hiểu đúng í bạn;
Nhấp chuột vào đây để mở rộng...

ý của e là 3 sheet: "So-Lieu", "Ket-Qua(1)", "Ket-Qua(2)" là 3 sheet chỉ được tạo ra khi ta chạy code thôi a ah.
Lúc ban đầu chỉ có duy nhất sheet "Thong-ke".
Ví du:
em tạo 1 sheet "Thong-ke" và tiến hành thống kê. khi thống kê xong e chạy code vba thì sẽ tự động tạo ra 3 sheet: "So-Lieu", "Ket-Qua(1)", "Ket-Qua(2)" có nội dung như ở file đính kèm bài #1.
Trong 3 sheet đó chỉ có sheet "So-Lieu" là thêm phần copy 4 cột e đánh dấu màu vàng ở bên sheet "Thong-ke" qua.
Còn 2 sheet "Ket-Qua(1)", "Ket-Qua(2)" thì giống file đính kèm.

Em trình bày vậy hy vọng giúp các anh dễ hiểu.
Nhờ các anh xem giúp cho.
Em cảm ơn!
 
Upvote 0
xucxich đã viết:
ý của e là 3 sheet: "So-Lieu", "Ket-Qua(1)", "Ket-Qua(2)" là 3 sheet chỉ được tạo ra khi ta chạy code thôi a ah.
Lúc ban đầu chỉ có duy nhất sheet "Thong-ke".
Ví du:
em tạo 1 sheet "Thong-ke" và tiến hành thống kê. khi thống kê xong e chạy code vba thì sẽ tự động tạo ra 3 sheet: "So-Lieu", "Ket-Qua(1)", "Ket-Qua(2)" có nội dung như ở file đính kèm bài #1.
Trong 3 sheet đó chỉ có sheet "So-Lieu" là thêm phần copy 4 cột e đánh dấu màu vàng ở bên sheet "Thong-ke" qua.
Còn 2 sheet "Ket-Qua(1)", "Ket-Qua(2)" thì giống file đính kèm.

Em trình bày vậy hy vọng giúp các anh dễ hiểu.
Nhờ các anh xem giúp cho.
Em cảm ơn!
Nhấp chuột vào đây để mở rộng...
Không có người trả lời là do mọi người không hiểu ý của bạn. Như đề xuất của bác HYen17, sao bạn không tạo ngay từ đầu mà cứ phải dùng code để tạo vì dữ liệu trên đó là cố định mà.
 
Upvote 0
xucxich đã viết:
ý của e là 3 sheet: "So-Lieu", "Ket-Qua(1)", "Ket-Qua(2)" là 3 sheet chỉ được tạo ra khi ta chạy code thôi a ah.
Lúc ban đầu chỉ có duy nhất sheet "Thong-ke".
Ví du:
em tạo 1 sheet "Thong-ke" và tiến hành thống kê. khi thống kê xong e chạy code vba thì sẽ tự động tạo ra 3 sheet: "So-Lieu", "Ket-Qua(1)", "Ket-Qua(2)" có nội dung như ở file đính kèm bài #1.
Trong 3 sheet đó chỉ có sheet "So-Lieu" là thêm phần copy 4 cột e đánh dấu màu vàng ở bên sheet "Thong-ke" qua.
Còn 2 sheet "Ket-Qua(1)", "Ket-Qua(2)" thì giống file đính kèm.

Em trình bày vậy hy vọng giúp các anh dễ hiểu.
Nhờ các anh xem giúp cho.
Em cảm ơn!
Nhấp chuột vào đây để mở rộng...
Làm đại cho bạn như file đính kèm.
 

File đính kèm

Upvote 0
Cảm ơn ban!
file đính kèm của bạn đã đáp ứng được yêu cầu của mình.
chỉ có cột số lượng và chiều dài là bị copy nhầm vị trí nhau thôi.
mình đã thay đổi vị trí của nó những vẫn ko copy được đúng vị trí.
mình nghĩ chắc ở đoạn code này thôi, bạn xem giúp mình
Mã: 
            Union(.Range("C13:C" & endR), .Range("I13:I" & endR), .Range("M13:M" & endR), .Range("J13:J" & endR)).Copy [c9]

p/s: Thực sự làm như yêu cầu của mình thì các sheet được trình bày ko đẹp như mẫu.
 
Upvote 0
huuthang_bd đã viết:
Không có người trả lời là do mọi người không hiểu ý của bạn. Như đề xuất của bác HYen17, sao bạn không tạo ngay từ đầu mà cứ phải dùng code để tạo vì dữ liệu trên đó là cố định mà.
Nhấp chuột vào đây để mở rộng...

Bảng thống kê này được tạo từ ad-ins thống kê thép của một bạn đồng nghiệp chia sẻ. với ad-ins này thì mình tạo được các bảng thống kê để thống kê thép.
mình muốn phát triển cho nó thêm một ứng dụng nữa liên quan đến các số liệu trong bảng thống kê nên mình mới nhờ giúp về code vba.
Ý kiến của bạn mình sẽ tiếp thu, có thể tạo 3 sheet trước, rồi sau đó chỉ việc dùng code copy 3 sheet là ok. lại được cái dễ dàng trình bày mẫu mã đẹp nữa.
cảm ơn bạn!
 
Upvote 0
xucxich đã viết:
Cảm ơn ban!
file đính kèm của bạn đã đáp ứng được yêu cầu của mình.
chỉ có cột số lượng và chiều dài là bị copy nhầm vị trí nhau thôi.
mình đã thay đổi vị trí của nó những vẫn ko copy được đúng vị trí.
mình nghĩ chắc ở đoạn code này thôi, bạn xem giúp mình
Mã: 
            Union(.Range("C13:C" & endR), .Range("I13:I" & endR), .Range("M13:M" & endR), .Range("J13:J" & endR)).Copy [c9]

p/s: Thực sự làm như yêu cầu của mình thì các sheet được trình bày ko đẹp như mẫu.
Nhấp chuột vào đây để mở rộng...
Bạn chỉnh code lại như sau:

Mã: 
Sub Test()
Dim endR As Integer
Application.ScreenUpdating = False
    Call xoa
    With Sheet1
        endR = .Range("C65000").End(xlUp).Row
        Worksheets.Add
            ActiveSheet.Name = "So-Lieu"
            Range("solieu").Copy [b2]
            Union(.Range("C13:C" & endR), .Range("I13:I" & endR), .Range("M13:M" & endR)).Copy [c9]
            .Range("J13:J" & endR).Copy [f9]
            Range("B9:B" & [c65000].End(xlUp).Row).FormulaR1C1 = "=ROW()-8"
            Cells.EntireColumn.AutoFit
        Worksheets.Add
            ActiveSheet.Name = "Ket-Qua(1)"
            Range("ketqua1").Copy [a1]
            Cells.EntireColumn.AutoFit
        Worksheets.Add
            ActiveSheet.Name = "Ket-Qua(2)"
            Range("ketqua2").Copy [a1]
            Cells.EntireColumn.AutoFit
        .Select
    End With
Application.ScreenUpdating = True

End Sub
 

File đính kèm

Upvote 0
Hai Lúa Miền Tây đã viết:
Bạn chỉnh code lại như sau:

Mã: 
Sub Test()
Dim endR As Integer
Application.ScreenUpdating = False
    Call xoa
    With Sheet1
        endR = .Range("C65000").End(xlUp).Row
        Worksheets.Add
            ActiveSheet.Name = "So-Lieu"
            Range("solieu").Copy [b2]
            Union(.Range("C13:C" & endR), .Range("I13:I" & endR), .Range("M13:M" & endR)).Copy [c9]
            .Range("J13:J" & endR).Copy [f9]
            Range("B9:B" & [c65000].End(xlUp).Row).FormulaR1C1 = "=ROW()-8"
            Cells.EntireColumn.AutoFit
        Worksheets.Add
            ActiveSheet.Name = "Ket-Qua(1)"
            Range("ketqua1").Copy [a1]
            Cells.EntireColumn.AutoFit
        Worksheets.Add
            ActiveSheet.Name = "Ket-Qua(2)"
            Range("ketqua2").Copy [a1]
            Cells.EntireColumn.AutoFit
        .Select
    End With
Application.ScreenUpdating = True

End Sub
Nhấp chuột vào đây để mở rộng...

Cảm ơn bạn!
Mình có câu hỏi này nhờ bạn.
1. Đoạn code xóa nếu trường hợp sheet Thong-Ke ko phải là sheet1 thì sẽ xóa hết.
Mình sửa đoạn code xóa lại như bên dưới mà nó ko chạy, nhờ bạn xem giúp.
Mã: 
Sub xoa()
Dim sh As Worksheet
Application.DisplayAlerts = False
For Each sh In ThisWorkbook.Sheets
    If UCase(sh.Name) = "So-Lieu" Then
        sh.Delete
    End If
    If UCase(sh.Name) = "Ket-Qua(1)" Then
        sh.Delete
    End If
    If UCase(sh.Name) = "Ket-Qua(2)" Then
        sh.Delete
    End If
Next
Application.DisplayAlerts = True


End Sub
2. Cái này mình mới phát hiện ra thôi nên bạn thông cảm vì mình không đưa vào yêu cầu ngay lúc đầu. nhờ bạn giúp mình chỉnh lại đoạn code copy phần chiều dài sao cho copy qua bên sheet số liệu thì tất cả chiều dài đều chia cho 1000. (mình muốn đổi từ đơn vị mm sang đơn vị m)
 
Upvote 0
xucxich đã viết:
Cảm ơn bạn!
Mình có câu hỏi này nhờ bạn.
1. Đoạn code xóa nếu trường hợp sheet Thong-Ke ko phải là sheet1 thì sẽ xóa hết.
Mình sửa đoạn code xóa lại như bên dưới mà nó ko chạy, nhờ bạn xem giúp.
Mã: 
Sub xoa()
Dim sh As Worksheet
Application.DisplayAlerts = False
For Each sh In ThisWorkbook.Sheets
    If UCase(sh.Name) = "So-Lieu" Then
        sh.Delete
    End If
    If UCase(sh.Name) = "Ket-Qua(1)" Then
        sh.Delete
    End If
    If UCase(sh.Name) = "Ket-Qua(2)" Then
        sh.Delete
    End If
Next
Application.DisplayAlerts = True


End Sub
2. Cái này mình mới phát hiện ra thôi nên bạn thông cảm vì mình không đưa vào yêu cầu ngay lúc đầu. nhờ bạn giúp mình chỉnh lại đoạn code copy phần chiều dài sao cho copy qua bên sheet số liệu thì tất cả chiều dài đều chia cho 1000. (mình muốn đổi từ đơn vị mm sang đơn vị m)
Nhấp chuột vào đây để mở rộng...
1./ Chỉnh lại code xóa sheet:

Mã: 
Sub xoa()
Dim sh As Worksheet
Application.DisplayAlerts = False
For Each sh In ThisWorkbook.Sheets
    If UCase(sh.Name) = "SO-LIEU" Or UCase(sh.Name) = "KET-QUA(1)" Or UCase(sh.Name) = "KET-QUA(2)" Then
        sh.Delete
    End If
Next
Application.DisplayAlerts = True

End Sub

2./ Chỉnh lại code theo yêu cầu của bạn:

Mã: 
Sub Test()
Dim endR As Integer
Application.ScreenUpdating = False
    Call xoa
    With Sheet1
        endR = .Range("C65000").End(xlUp).Row
        Worksheets.Add
            ActiveSheet.Name = "So-Lieu"
            Range("solieu").Copy [b2]
            Union(.Range("C13:C" & endR), .Range("I13:I" & endR), .Range("M13:M" & endR)).Copy [c9]
            .Range("J13:J" & endR).Copy [f9]
            .Range("AC8").Copy: Range("F9:F" & [F65000].End(xlUp).Row).PasteSpecial 1, xlDivide
            [a1].Select
            Range("B9:B" & [c65000].End(xlUp).Row).FormulaR1C1 = "=ROW()-8"
            Cells.EntireColumn.AutoFit
        Worksheets.Add
            ActiveSheet.Name = "Ket-Qua(1)"
            Range("ketqua1").Copy [a1]
            Cells.EntireColumn.AutoFit
        Worksheets.Add
            ActiveSheet.Name = "Ket-Qua(2)"
            Range("ketqua2").Copy [a1]
            Cells.EntireColumn.AutoFit
        .Select
    End With
Application.ScreenUpdating = True

End Sub
 

File đính kèm

Upvote 0
Mã: 
.Range("J9").Copy: Range("F9:F" & [F65000].End(xlUp).Row).PasteSpecial 1, xlDivide
Đoạn code trên bạn cho nó copy nguyên công thức, nên dễ bị lỗi nếu ô được copy là công thức chứ ko phải là 1 số liệu cụ thể.
Bạn có thể giúp sửa nó sao cho chỉ copy giá trị và chia cho 1000.
mình cảm ơn!
 
Upvote 0
xucxich đã viết:
Mã: 
.Range("J9").Copy: Range("F9:F" & [F65000].End(xlUp).Row).PasteSpecial 1, xlDivide
Đoạn code trên bạn cho nó copy nguyên công thức, nên dễ bị lỗi nếu ô được copy là công thức chứ ko phải là 1 số liệu cụ thể.
Bạn có thể giúp sửa nó sao cho chỉ copy giá trị và chia cho 1000.
mình cảm ơn!
Nhấp chuột vào đây để mở rộng...

Gán đại cho cell nào đó là 1000 rồi copy nó dán vào là được.

Mã: 
Sub Test()
Dim endR As Integer
Application.ScreenUpdating = False
    Call xoa
    With Sheet1
        endR = .Range("C65000").End(xlUp).Row
        Worksheets.Add
            ActiveSheet.Name = "So-Lieu"
            Range("solieu").Copy [b2]
            Union(.Range("C13:C" & endR), .Range("I13:I" & endR), .Range("M13:M" & endR)).Copy [c9]
            .Range("J13:J" & endR).Copy [f9]
           [COLOR=#0000cd] .[IV1].Value = 1000: .[IV1].Copy[/COLOR]
            Range("F9:F" & [F65000].End(xlUp).Row).PasteSpecial 1, xlDivide
            [a1].Select
            Range("B9:B" & [c65000].End(xlUp).Row).FormulaR1C1 = "=ROW()-8"
            Cells.EntireColumn.AutoFit
        Worksheets.Add
            ActiveSheet.Name = "Ket-Qua(1)"
            Range("ketqua1").Copy [a1]
            Cells.EntireColumn.AutoFit
        Worksheets.Add
            ActiveSheet.Name = "Ket-Qua(2)"
            Range("ketqua2").Copy [a1]
            Cells.EntireColumn.AutoFit
        .Select
    End With
Application.ScreenUpdating = True

End Sub
 

File đính kèm

Upvote 0
Cảm ơn bạn!
ý của mình là nếu ở cột J là công thức chứ không phải giá trị được nhập vào thì khi chạy code sẽ bị lỗi.
Mình có gửi file đính kèm, bạn xem chạy code sẽ thấy lỗi.
 

File đính kèm

Upvote 0
xucxich đã viết:
Cảm ơn bạn!
ý của mình là nếu ở cột J là công thức chứ không phải giá trị được nhập vào thì khi chạy code sẽ bị lỗi.
Mình có gửi file đính kèm, bạn xem chạy code sẽ thấy lỗi.
Nhấp chuột vào đây để mở rộng...
Chuyển cột đó về giá trị là được.
Mã: 
Sub Test()
Dim endR As Integer
Application.ScreenUpdating = False
    Call xoa
    With Sheet1
        endR = .Range("C65000").End(xlUp).Row
        Worksheets.Add
            ActiveSheet.Name = "So-Lieu"
            Range("solieu").Copy [b2]
            Union(.Range("C13:C" & endR), .Range("I13:I" & endR), .Range("M13:M" & endR)).Copy [c9]
            [COLOR=#0000ff].Range("J13:J" & endR).Copy: [f9].PasteSpecial 3[/COLOR]
            .[IV1].Value = 1000: .[IV1].Copy
            Range("F9:F" & [F65000].End(xlUp).Row).PasteSpecial 1, xlDivide
            [a1].Select
            Range("B9:B" & [c65000].End(xlUp).Row).FormulaR1C1 = "=ROW()-8"
            Cells.EntireColumn.AutoFit
        Worksheets.Add
            ActiveSheet.Name = "Ket-Qua(1)"
            Range("ketqua1").Copy [a1]
            Cells.EntireColumn.AutoFit
        Worksheets.Add
            ActiveSheet.Name = "Ket-Qua(2)"
            Range("ketqua2").Copy [a1]
            Cells.EntireColumn.AutoFit
        .Select
    End With
Application.ScreenUpdating = True

End Sub
 

File đính kèm

Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

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

D
in ra bị thiếu chữ (1 người xem)
Trả lời
3
Đọc
31
ptm0412
ptm0412
Momominh
Hỏi công thức tìm tuần thiếu hàng
Trả lời
1
Đọc
34
hoangtuaotrang_hp_vn
H
2
EM MUỐN TẠO MA TRẬN BIẾN ĐỔI GIÁ TRỊ PHẦN TỬ NGẪU NHIÊN (1 người xem)
Trả lời
2
Đọc
28
ptm0412
ptm0412
V
  • Question Question
Tạo dữ liệu random cho từng sheet dựa theo dữ liệu có sẵn
Trả lời
2
Đọc
69
victoriabmt
V
Emyeuexcel
Cộng 4 tuần theo 1 qui luật qui định
Trả lời
34
Đọc
2K
Emyeuexcel
Emyeuexcel
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
2 3 4
Trả lời
394
Đọc
46K
ThanhsonLC
T
hieuxd
  • Question Question
Khi nhập dữ liệu tự động chèn thêm dòng khi số dòng trong bảng mẫu sắp hết
Trả lời
24
Đọc
25K
dungpham01
D
Gà Con yêu VBA
Mở Pass file excel phiên bản .xlsx , xlsm, xlsb
Trả lời
6
Đọc
274
YêuCN
Y
S
Mở 2 cửa sổ riêng biệt
Trả lời
31
Đọc
24K
ThanhNgan240723
T
ongke0711
  • Question Question
Tra cứu thông tin mã số thuế (cập nhật lại code cũ)
    • Thích
    • Cảm ơn
    • Yêu thích
Trả lời
7
Đọc
428
ongke0711
ongke0711
vn81206
TRA CỨU MÃ SỐ THUẾ CÁ NHÂN QUA EXCEL
    • Buồn
Trả lời
57
Đọc
20K
vovietdung261016
V
PhanTuHuong
CHỌN VÀ SỬ DỤNG MÁY LỌC KHÔNG KHÍ (1 người xem)
    • Thích
    • Cảm ơn
Trả lời
7
Đọc
1K
PhanTuHuong
PhanTuHuong
huuthang_bd
Add in SwitchSheet: Quay lại các sheet đã xem trước đó bằng phím tắt
    • Thích
    • Yêu thích
2
Trả lời
146
Đọc
42K
phong_codon
P
N
  • Question Question
Hỗ trợ tiếng việt trong macro
Trả lời
14
Đọc
596
Quang_Hải
Quang_Hải
N
Cài phần mềm đọc số ra chữ
Trả lời
2
Đọc
116
Nguyễn Duy Tuân
Nguyễn Duy Tuân
T
Em cần hỗ trợ tách nhiều file và đặt tên theo quy ước chung từ bảng 01 excel có sẳng
Trả lời
1
Đọc
101
HUONGHCKT
H
N
hàm đếm theo dòng
Trả lời
1
Đọc
87
dungpham01
D
H
LỖI KHOẢNG TRỐNG EXCEL DƯỚI THANH CÔNG CỤ
Trả lời
1
Đọc
60
ptm0412
ptm0412
A
  • Question Question
Share file copy dữ liệu từ tờ khai hải quan.
    • Thích
Trả lời
10
Đọc
987
anhdepjai
A
dungluyen2119
  • Question Question
Code VBA để tính tổng theo chiều ngang mà số cột không cố định
Trả lời
6
Đọc
323
le_vis
L
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

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom