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)

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

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

MinhCong

Thành viên gắn bó
Tham gia
28/5/09
Bài viết
1,645
Được thích
1,806
Nghề nghiệp
Xây dựng Cầu đường
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!
 

File đính kèm

mình phải làm 1 bài thuyết trình về những ứng dụng của excel mà chưa biết làm thế nào. Bác nào có tài liệu về excel giúp em với.
em cũng không biết macro là gì luôn.hix
 
Upvote 0
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
Rất tuyệt. Anh cho Em hỏi, sao khi Mình copy thì những vùng đã "Merge and center" và "Decrease Indent" bị trở về vị trí ban đầu hết không còn nữa.
 
Upvote 0
Rất tuyệt. Anh cho Em hỏi, sao khi Mình copy thì những vùng đã "Merge and center" và "Decrease Indent" bị trở về vị trí ban đầu hết không còn nữa.
Vậy sửa lại tí:
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 .Offset(45).Resize((n - 1) * 45)
    End With
  End If
  Application.ScreenUpdating = True
End Sub
Kiểm tra lại thử xem thế nào nhé
 
Upvote 0
Cho Em hỏi:
1/ nếu muốn tạo thêm 1 nút bấm nữa thì dòng code sau Em có cần khai báo biến đưa về 1 khai báo chung ở trên như thế nào nhỉ? Tương tư cho nhỉều nút khác nữa. Dữ liệu đầu vào chỉ khác nhau ở vùng "tìm giá trị lớn nhất Range(....)" và tên sheets(....).
2/ Mình có thể gộp lại thành 1 nút bấm không nhỉ?
Mã:
Private Sub CommandButton1_Click()
  Dim n As Long
  Application.ScreenUpdating = False
  n = WorksheetFunction.Max(Sheets("Menu").[COLOR=Red]Range("A:A")[/COLOR])
  If n > 1 Then
    With Sheets([COLOR=Red]"Daomong"[/COLOR]).Range(("1:46"))
      .Copy .Offset(46).Resize((n - 1) * 46)
    End With
  End If
  Application.ScreenUpdating = True
End Sub
-----------------------------------
Private Sub CommandButton2_Click()
  Dim n As Long
  Application.ScreenUpdating = False
  n = WorksheetFunction.Max(Sheets("Menu").[COLOR=Red]Range("G:G")[/COLOR])
  If n > 1 Then
    With Sheets([COLOR=Red]"BT4x6"[/COLOR]).Range(("1:46"))
      .Copy .Offset(46).Resize((n - 1) * 46)
    End With
  End If
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Cho Em hỏi:
1/ nếu muốn tạo thêm 1 nút bấm nữa thì dòng code sau Em có cần khai báo biến đưa về 1 khai báo chung ở trên như thế nào nhỉ? Tương tư cho nhỉều nút khác nữa. Dữ liệu đầu vào chỉ khác nhau ở vùng "tìm giá trị lớn nhất Range(....)" và tên sheets(....).
2/ Mình có thể gộp lại thành 1 nút bấm không nhỉ?
Hỏi lại: Với file thực tế của bạn thì bạn cần tối đa bao nhiêu nút?
Nếu có thể được, bạn làm sẳn vài nút, viết code theo ý bạn rồi gữi lên đây nhé! Nói không chừng tôi sẽ có cách gom chúng thành 1 code duy nhất đấy
 
Upvote 0
Hỏi lại: Với file thực tế của bạn thì bạn cần tối đa bao nhiêu nút?
Nếu có thể được, bạn làm sẳn vài nút, viết code theo ý bạn rồi gữi lên đây nhé! Nói không chừng tôi sẽ có cách gom chúng thành 1 code duy nhất đấy
Rất cảm ơn Anh đã quan tâm giúp đỡ. 1 File tối đa ngót nghét khoảng 20÷25 nút lận.
Em copy cái code của Anh ra và tạo thành 6 đoạn code tương ứng với 6 nút. Anh xem giúp có thể gom lại được thành 1 code duy nhất, còn mấy cái còn lại Em sẽ căn cứ theo đoạn code của Anh vừa lập và hoàn thiện tiếp.
 

File đính kèm

Upvote 0
Rất cảm ơn Anh đã quan tâm giúp đỡ. 1 File tối đa ngót nghét khoảng 20÷25 nút lận.
Em copy cái code của Anh ra và tạo thành 6 đoạn code tương ứng với 6 nút. Anh xem giúp có thể gom lại được thành 1 code duy nhất, còn mấy cái còn lại Em sẽ căn cứ theo đoạn code của Anh vừa lập và hoàn thiện tiếp.
Bạn xem code này:
PHP:
Sub Main()
  Dim n As Long, ShN As String
  With Sheets("Menu")
    ShN = .Shapes(Application.Caller).TextFrame.Characters.Text
    n = WorksheetFunction.Max(.Range("1:1").Find(ShN, , , xlWhole)(1, 1).EntireColumn)
  End With
  With Sheets(ShN).Range("A1:Q45")
    If n > 1 Then .Copy .Offset(45).Resize((n - 1) * 45)
  End With
End Sub
Chú ý:
- Tại dòng 1 của sheet Menu tôi có gõ các tiêu đề với mục đích đánh dấu (để biết sẽ làm việc tại sheet nào)
- Dữ liệu tại dòng 1 này và text mà tôi gõ trong các Button đều dùng Font Unicode (chú ý nha)
- Nếu bạn thêm nút, chỉ việc Assign Macro nút ấy với Sub Main là được
 

File đính kèm

Upvote 0
Web KT

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

Back
Top Bottom