Nhờ giúp tạo Macro copy 1 trang in bên trên và dán vào trang in bên dưới! (1 người xem)

MinhCong · 4/5/10

Xin chào các Anh Chị!
Tôi có vấn đề cần nhờ giúp đỡ như sau:
Tôi có 1 sheet Menu (là dữ liệu đầu vào), và có rất nhiều sheet là những Biên bản cho từng hạng mục. Trong những sheet này đều có 1 biên Bản làm mẫu chuẩn (VD: Định dạng trang in chuẩn, liên kết công thức với bên sheet Menu...)
Tôi Muốn thêm dữ liệu số biên bản bên sheet Menu và chỉ cần bấm nút thực hiện thì tất cả các Biên bản bên những sheet kia (những sheet có dữ liệu liên kết với sheet Menu) tự động copy Biên bản số 1 bên trên và cho vào những trang in bên dưới.
Trong file gửi đính kèm Tôi có ghi rõ.
Rất mong sự giành chút ít thời gian giúp đỡ của các Anh Chị! Xin chân thành cảm ơn!

Hai Lúa Miền Tây · 4/5/10

MinhCong đã viết:
Xin chào các Anh Chị!
Tôi có vấn đề cần nhờ giúp đỡ như sau:
Tôi có 1 sheet Menu (là dữ liệu đầu vào), và có rất nhiều sheet là những Biên bản cho từng hạng mục. Trong những sheet này đều có 1 biên Bản làm mẫu chuẩn (VD: Định dạng trang in chuẩn, liên kết công thức với bên sheet Menu...)
Tôi Muốn thêm dữ liệu số biên bản bên sheet Menu và chỉ cần bấm nút thực hiện thì tất cả các Biên bản bên những sheet kia (những sheet có dữ liệu liên kết với sheet Menu) tự động copy Biên bản số 1 bên trên và cho vào những trang in bên dưới.
Trong file gửi đính kèm Tôi có ghi rõ.
Rất mong sự giành chút ít thời gian giúp đỡ của các Anh Chị! Xin chân thành cảm ơn!

Chép code sau vào Module

Mã:

Public Ten As String
'----------------------
'Code copy sheet dua vao sheet Daomong
Sub CopySheet()
Dim chuoi
Dim dem As Integer
Application.ScreenUpdating = False
On Error Resume Next
Call XoaSheet
For i = 1 To Sheets("Menu").Range("a65500").End(xlUp).Value
    Ten = i
    Sheets.Add
    Sheets("Daomong").Select
    Cells.Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets(Ten).Select
    Range("A1").Select
    ActiveSheet.Paste
    chuoi = chuoi & "lll"
    dem = dem + 1
    Application.StatusBar = chuoi & "--> " & " " & dem & _
            "/" & Sheets("Menu").Range("a65500").End(xlUp).Value & " sheet da duoc tao."
    Sheets(Ten).[k9] = Ten
    Sheets(Ten).[a1].Select
Next

  Application.DisplayAlerts = True
  MsgBox "Ban vua tao duoc " & dem & " Sheet", vbInformation, "Tao sheet"
  Sheets("menu").Select
  Application.StatusBar = ""
  
End Sub
'---------------------------
'Code xoa sheet
Sub XoaSheet()
Dim sh As Worksheet
Application.DisplayAlerts = False
For Each sh In ThisWorkbook.Sheets
   If UCase(sh.CodeName) <> "SHEET1" And UCase(sh.CodeName) <> "SHEET2" And UCase(sh.CodeName) <> "SHEET23" _
                And UCase(sh.CodeName) <> "SHEET26" And UCase(sh.CodeName) <> "SHEET5" Then
      sh.Delete
   End If
Next
Application.DisplayAlerts = True
End Sub

Chép code sau vào ThisWorkbook

Mã:

Private Sub Workbook_NewSheet(ByVal sh As Object)
  sh.Move After:=Sheets(Sheets.Count)
  If Ten <> "" Then sh.Name = Ten

End Sub

Bạn xem file đính kèm nhé

MinhCong · 4/5/10

Không phải như thế rồi Anh dom ơi! Để Mình nói lại cho rõ nhé:
Mình muốn copy trang in trong cùng 1 sheet kia, không phải copy ra nhiều sheet.
Anh để ý giúp định dạng trang in trong 1 sheet có số dòng là (46 dòng), vì vậy những biên bản kế tiếp sẽ bắt đầu dòng cuối cùng của trang in phía trên.
VD: Trong sheet Daomong: Biên bản 1 có tổng cộng 46 dòng (từ dòng 1:46). Khi mình copy bỏ xuống dưới thì dòng đầu tiên của Biên bản 2 phải là dòng thứ 47 (từ dòng 47:92),....
Mình muốn có kết quả như trong sheet Daomong ấy (Trong file sau nhé!)

concogia · 4/5/10

MinhCong đã viết:
Không phải như thế rồi Anh dom ơi! Để Mình nói lại cho rõ nhé:
Mình muốn copy trang in trong cùng 1 sheet kia, không phải copy ra nhiều sheet.
Anh để ý giúp định dạng trang in trong 1 sheet có số dòng là (46 dòng), vì vậy những biên bản kế tiếp sẽ bắt đầu dòng cuối cùng của trang in phía trên.
VD: Trong sheet Daomong: Biên bản 1 có tổng cộng 46 dòng (từ dòng 1:46). Khi mình copy bỏ xuống dưới thì dòng đầu tiên của Biên bản 2 phải là dòng thứ 47 (từ dòng 47:92),....
Mình muốn có kết quả như trong sheet Daomong ấy (Trong file sau nhé!)

Cái này theo mình mỗi hạng mục bạn tạo một nút, vì dâu phải lúc nào công việc cũng giống nhau, nhập liệu cùng lúc đâu, cứ nhập xong "em" nào mà muốn in thì "thịt" em nấy
Hihi, đang tập viết nên làm đại, trúng trật hên xui
Thân

MinhCong · 4/5/10

concogia đã viết:
Cái này theo mình mỗi hạng mục bạn tạo một nút, vì dâu phải lúc nào công việc cũng giống nhau, nhập liệu cùng lúc đâu, cứ nhập xong "em" nào mà muốn in thì "thịt" em nấy
Hihi, đang tập viết nên làm đại, trúng trật hên xui
Thân

Rất tuyệt, đúng ý Em rồi.

Mã:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
    Dim vung, sao As Range, i, j As Integer
        Set vung = Range([A4], [A4].End(xlDown))
        Set sao = Sheets("daomong").Range(("A1:Q[COLOR=Red]46[/COLOR]"))
        j = sao.Rows.Count
            For i = 1 To vung.Rows.Count - 1
                sao.Copy
                Sheets("daomong").Select
                Sheets("daomong").Cells(i * j + [COLOR=Red]1[/COLOR], 1).Select
                ActiveSheet.Paste
            Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Áp dụng cho file của E, đổi 44 thành 46 và +2 bằng +1 (chữ màu đỏ) là OK rồi.
Cái này nếu áp dụng chạy cho tất cả các sheet (trừ 2 sheet Menu và thông số) nữa là tuyệt.

MinhCong · 4/5/10

Anh CÒ GIÀ ơi! Nếu trong vùng đếm (từ cell A4 trở xuống) có giá trị "trống hoặc bằng 0" thì nó sẽ đếm tất tần tật, có cách nào không đếm những giá trị này không? Vì nếu đếm luôn những giá trị này nó sẽ cho ra số lượng Biên Bản nhiều.
Hơn nữa nếu có tới cả trăm số Biên Bản có lẽ dùng vòng lặp chạy hơi bị đuối. Anh có cách nào khác không?

Hai Lúa Miền Tây · 4/5/10

MinhCong đã viết:
Anh CÒ GIÀ ơi! Nếu trong vùng đếm (từ cell A4 trở xuống) có giá trị "trống hoặc bằng 0" thì nó sẽ đếm tất tần tật, có cách nào không đếm những giá trị này không? Vì nếu đếm luôn những giá trị này nó sẽ cho ra số lượng Biên Bản nhiều.
Hơn nữa nếu có tới cả trăm số Biên Bản có lẽ dùng vòng lặp chạy hơi bị đuối. Anh có cách nào khác không?

Góp ý với bạn: Có Data gốc rồi, bây giờ mục đích của bạn là đưa dữ liệu sang sheet Daomong để in thì không nhất thiết phải copy ra nhiều cái như vậy, nếu đúng thế thì ta đi tiếp.

MinhCong · 4/5/10

domfootwear đã viết:
Góp ý với bạn: Có Data gốc rồi, bây giờ mục đích của bạn là đưa dữ liệu sang sheet Daomong để in thì không nhất thiết phải copy ra nhiều cái như vậy, nếu đúng thế thì ta đi tiếp.

Mỗi Biên bản là "tên 1 hạng mục khác nhau và dữ liệu trong nó cũng khác nhau". Nhờ Anh sửa giúp Mình đoạn code trong sheet Menu để nó không đếm những giá trị trống từ ô A9:A12 nhé.

concogia · 4/5/10

MinhCong đã viết:
Mỗi Biên bản là "tên 1 hạng mục khác nhau và dữ liệu trong nó cũng khác nhau". Nhờ Anh sửa giúp Mình đoạn code trong sheet Menu để nó không đếm những giá trị trống từ ô A9:A12 nhé.

Mã:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
    Dim vung, sao As Range, i, j As Integer
       [COLOR=red]Set vung = Range([b4], [b5000].End(xlUp))[/COLOR]
        Set sao = Sheets("daomong").Range(("a1:q46"))
        j = sao.Rows.Count
            [COLOR=red]If vung.Rows.Count = 1 Then Exit Sub[/COLOR]
            For i = 1 To vung.Rows.Count - 1
                sao.Copy
                Sheets("daomong").Select
                Sheets("daomong").Cells(i * j + 1, 1).Select
                ActiveSheet.Paste
            Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Vì ở cột A là công thức ,cột B dùng Merge nên tạm thời bạn sửa tý thế này xem sao
Nếu chắc chắn có dữ liệu mới in thì có thể bỏ cái If vung......
Hy vọng được
Mình thử chạy 100 biên bản mà nó đâu cự nự gì đâu_ "roẹt" một cái là xong ( nhưng chắc công việc của bạn đâu có nhiều dữ vậy), mấy cái này bạn thừa sức "ẹo qua ẹo lại" được mà
Thân

MinhCong · 5/5/10

Nhờ Anh xem giúp lại sao đoạn code này nó chạy chậm lắm:

Mã:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
    Dim vung, sao As Range, i, j As Integer
        Set vung = Range([B4], [B4].End(xlDown))
        Set sao = Sheets("daomong").Rows(("1:46"))
        j = sao.Rows.Count
       [COLOR=Red] If vung.Rows.Count <= 1 Then Exit Sub[/COLOR]
            For i = 1 To vung.Rows.Count - 1
                sao.Copy
                Sheets("daomong").Select
                Sheets("daomong").Cells(i * j + 1, 1).Select
                ActiveSheet.Paste
            Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Cái dòng lệnh IF ấy. Khi bỏ vào chạy nếu từ B4 trở xuống mà có 2 giá trị trở lên thì chạy bình thường, còn nếu <=1 thì nó chạy ì ạch và copy ra rất nhiều biên bản bên dưới của sheet Daomong.
Mục đích Em muốn nếu từ B4 trở xuống nếu chứa <=1 giá trị thì tự động thoát luôn.

MinhCong · 5/5/10

Nếu Em muốn tạo thêm cái CommandButton2_Click(), CommandButton3_Click(),.....Thì có phải copy bỏ xuống dưới không? Khi đó "vung" và "sao" nó sẽ khác, vậy ta có cần khai báo biến tổng quát ở trên cùng như thế nào?

concogia · 5/5/10

MinhCong đã viết:
Nhờ Anh xem giúp lại sao đoạn code này nó chạy chậm lắm:

Mã:

Private Sub CommandButton1_Click() Application.ScreenUpdating = False Dim vung, sao As Range, i, j As Integer Set vung = Range([B4], [B4].End(xlDown)) Set sao = Sheets("daomong").Rows(("1:46")) j = sao.Rows.Count [COLOR=red]If vung.Rows.Count <= 1 Then Exit Sub[/COLOR] For i = 1 To vung.Rows.Count - 1 sao.Copy Sheets("daomong").Select Sheets("daomong").Cells(i * j + 1, 1).Select ActiveSheet.Paste Next Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

Cái dòng lệnh IF ấy. Khi bỏ vào chạy nếu từ B4 trở xuống mà có 2 giá trị trở lên thì chạy bình thường, còn nếu <=1 thì nó chạy ì ạch và copy ra rất nhiều biên bản bên dưới của sheet Daomong.
Mục đích Em muốn nếu từ B4 trở xuống nếu chứa <=1 giá trị thì tự động thoát luôn.

Sao kỳ vậy ta
Có thể tóm lại như thế này:
Nếu ở B4 không có dữ liệu thì mình không quan tâm vì có gì đâu để in
Nếu ở B4 có dữ liệu và trống từ B5 lúc này có một biên bản nên cũng không cần bấm, nếu lỡ bấm nút thì nó cũng đâu làm gì (do "thằng" If làm thoát sub rôi mà), mình thử cho B5 có giá trị B6 trống nó vẫn chạy ngon mà Minhcong, những cái này do khai báo địa chỉ, mình nghĩ Minhcong có thể sửa cho nó như ý muốn được mà
Thân

ndu96081631 · 5/5/10

MinhCong đã viết:
Hơn nữa nếu có tới cả trăm số Biên Bản có lẽ dùng vòng lặp chạy hơi bị đuối. Anh có cách nào khác không?

Bạn thí nghiệm thế này:
- Tại sheet Daomong, bạn quét chọn A1:Q45 rồi Ctrl + C
- Quét chọn A46:Q180 rồi Ctrl + V
Chỉ 1 thao tác bạn đã có được 4 bản copy ---> Từ đó suy ra có thể chẳng cần đến vòng lập nào cũng chơi được tuốt

MinhCong · 5/5/10

concogia đã viết:
Sao kỳ vậy ta
Có thể tóm lại như thế này:
Nếu ở B4 không có dữ liệu thì mình không quan tâm vì có gì đâu để in
Nếu ở B4 có dữ liệu và trống từ B5 lúc này có một biên bản nên cũng không cần bấm, nếu lỡ bấm nút thì nó cũng đâu làm gì (do "thằng" If làm thoát sub rôi mà), mình thử cho B5 có giá trị B6 trống nó vẫn chạy ngon mà Minhcong, những cái này do khai báo địa chỉ, mình nghĩ Minhcong có thể sửa cho nó như ý muốn được mà
Thân

Em cũng không biết sao nữa, (Tức từ B4 trở xuống, không có giá trị hoặc chỉ có giá trị ở ô B4) thì hàm trên Em bấm nó tèo lắm chạy chậm kinh khủng và nó cho ra 1 mớ biên bản. Còn nếu ở B4 trống, B5 có giá trị thì đúng là nó chạy.
Cái muốn nói ở đây là bắt đầu từ B4 đó Anh.

Hai Lúa Miền Tây · 5/5/10

MinhCong đã viết:
Em cũng không biết sao nữa, (Tức từ B4 trở xuống, không có giá trị hoặc chỉ có giá trị ở ô B4) thì hàm trên Em bấm nó tèo lắm chạy chậm kinh khủng và nó cho ra 1 mớ biên bản. Còn nếu ở B4 trống, B5 có giá trị thì đúng là nó chạy.
Cái muốn nói ở đây là bắt đầu từ B4 đó Anh.

Bạn muốn không cần dòng lặp thì dùng theo cách của thầy Tuấn, còn muốn giữ lặp trường như cũ thì thay vì dùng hàm đếm, bạn dùng InputBox để nhập trực tiếp từ số biên bản đến số biên bản cần tạo.

ndu96081631 · 5/5/10

MinhCong đã viết:
Em cũng không biết sao nữa, (Tức từ B4 trở xuống, không có giá trị hoặc chỉ có giá trị ở ô B4) thì hàm trên Em bấm nó tèo lắm chạy chậm kinh khủng và nó cho ra 1 mớ biên bản. Còn nếu ở B4 trống, B5 có giá trị thì đúng là nó chạy.
Cái muốn nói ở đây là bắt đầu từ B4 đó Anh.

đương nhiên rồi... tại trong code có dùng End(xldown) mà... nguy hiểm lắm nha.

MinhCong · 5/5/10

ndu96081631 đã viết:
Bạn thí nghiệm thế này:
- Tại sheet Daomong, bạn quét chọn A1:Q45 rồi Ctrl + C
- Quét chọn A46:Q180 rồi Ctrl + V
Chỉ 1 thao tác bạn đã có được 4 bản copy ---> Từ đó suy ra có thể chẳng cần đến vòng lập nào cũng chơi được tuốt

Em làm theo ý của Anh đúng là hay thật. Theo ý Anh có phải thuật toán như vầy không?
B1: Bên sheet Menu tìm ra giá trị lớn nhất ở cột A (từ A4 trở xuống) - 1 (trừ 1 do đã có 1 biên bản rồi) => Được kết quả n.
Chọn mảng có số dòng n*45 bắt đầu từ dòng 46 và copy từ dòng 1:45 dán vào.
VD: Max(A4:A1000)=5-1=4. => Vùng chọn có số dòng là 4*45=180. Vậy vùng được chọn bắt đầu từ dòng 46:225)
Nhờ Anh cho Em đoạn code đi.

concogia · 5/5/10

ndu96081631 đã viết:
đương nhiên rồi... tại trong code có dùng End(xldown) mà... nguy hiểm lắm nha.

Cái đó cũ Thầy ơi, bạn í đưa nhầm đó
Theo gợi ý của Thầy mình bỏ For, Thầy xem ổn chưa

Mã:

Private Sub CommandButton2_Click()
Application.ScreenUpdating = False
    Dim vung, sao As Range, i, j As Integer
        Set vung = Range([b4], [b5000].End(xlUp))
        Set sao = Sheets("daomong").Range(("a1:q46"))
        j = sao.Rows.Count
        i = vung.Rows.Count
            If vung.Rows.Count = 1 Then Exit Sub
                sao.Copy
                Sheets("daomong").Select
                Sheets("daomong").Range("a47:a" & i * j).Select
                ActiveSheet.Paste
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Còn khi in, hình như bạn Minhcong muốn in tất cả vào Sheet daomong?

MinhCong · 5/5/10

concogia đã viết:
Cái đó cũ Thầy ơi, bạn í đưa nhầm đó
Theo gợi ý của Thầy mình bỏ For, Thầy xem ổn chưa

Mã:

Private Sub CommandButton2_Click() Application.ScreenUpdating = False Dim vung, sao As Range, i, j As Integer Set vung = Range([b4], [b5000].End(xlUp)) Set sao = Sheets("daomong").Range(("a1:q46")) j = sao.Rows.Count i = vung.Rows.Count If vung.Rows.Count = 1 Then Exit Sub sao.Copy Sheets("daomong").Select Sheets("daomong").Range("a47:a" & i * j).Select ActiveSheet.Paste Application.CutCopyMode = False Application.ScreenUpdating = True End Sub

Còn khi in, hình như bạn Minhcong muốn in tất cả vào Sheet daomong?

Bên sheet Menu là dữ liệu đầu vào. Còn cái quan trọng là đưa ra tất cả các Biên bản bên sheet Daomong và in ấn cũng bên sheet Daomong luôn Anh à.

ndu96081631 · 5/5/10

MinhCong đã viết:
Em làm theo ý của Anh đúng là hay thật. Theo ý Anh có phải thuật toán như vầy không?
B1: Bên sheet Menu tìm ra giá trị lớn nhất ở cột A (từ A4 trở xuống) - 1 (trừ 1 do đã có 1 biên bản rồi) => Được kết quả n.
Chọn mảng có số dòng n*45 bắt đầu từ dòng 46 và copy từ dòng 1:45 dán vào.
VD: Max(A4:A1000)=5-1=4. => Vùng chọn có số dòng là 4*45=180. Vậy vùng được chọn bắt đầu từ dòng 46:225)
Nhờ Anh cho Em đoạn code đi.

thì vầy đi:

PHP:

Private Sub CommandButton1_Click()
  Dim n As Long
  Application.ScreenUpdating = False
  n = WorksheetFunction.Max(Sheets("Menu").Range("A:A"))
  If n > 0 Then
    With Sheets("daomong").Range(("A1:Q45"))
      .Copy .Resize(n * 45)
    End With
  End If
  Application.ScreenUpdating = True
End Sub

Nhờ giúp tạo Macro copy 1 trang in bên trên và dán vào trang in bên dưới! (1 người xem)

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

Thành viên gắn bó

File đính kèm

❆❆❆❆❆❆❆❆

File đính kèm

Thành viên gắn bó

File đính kèm

Gội rồi mới Cạo

File đính kèm

Thành viên gắn bó

Thành viên gắn bó

❆❆❆❆❆❆❆❆

Thành viên gắn bó

Gội rồi mới Cạo

Thành viên gắn bó

Thành viên gắn bó

Gội rồi mới Cạo

Huyền thoại GPE

Thành viên gắn bó

❆❆❆❆❆❆❆❆

Huyền thoại GPE

Thành viên gắn bó

Gội rồi mới Cạo

Thành viên gắn bó

Huyền thoại GPE

Đếm ngược thời gian