combine two code

Unexpc

Active Member
Joined
Nov 12, 2020
Messages
496
Office Version
  1. 2019
Platform
  1. Windows
Hi guys
i have a code that copy selection code in a sheet have main data and paste in specific sheet and print from another specific sheet (first code)
however, i have a another code that copy/paste pages a sheet that named Print, but how
when fill cells that number in sequence(67,99,...) in a sheet that named Sheet, for example when cell 67 is fill, in Print copy page 2 and paste on page 3 and when cell 99 is fill, that is doing like before, copy page 3 and paste on page 4 and continue... (second code)
how combine this two code? second code can't doing with first code, because first code doing copy/paste and not enable events and not filling cell happened
what are thinking about that combine second code with first code with same function?
first code
VBA Code:
Sub CopyPaste()
Dim ShP As Worksheet, DSheet As Worksheet, SrRange As Range, i As Long, k As Long, L As Long
Dim MyRange As Range, ws As Worksheet, Lastrow As Long, n As Long, j As Long
Dim PrintArea As String, FC As Long, LC As Long, Fr As Long, Lr As Long, Y As Long
Application.ScreenUpdating = False
Set ShP = Worksheets("Sheet")
Set DSheet = ActiveSheet
Set SrRange = Selection
FC = SrRange.Column
LC = SrRange.Columns.Count
Fr = SrRange.Row
Lr = SrRange.Rows.Count + Fr - 1
Y = Fr - SrRange.Rows.Count
k = Fr + Application.WorksheetFunction.CountBlank(Range(Cells(Fr, FC), Cells(Lr, FC)))
For i = Fr To 1 Step -1
If Cells(i, FC).Interior.Color = 4697456 And Cells(i, FC).Value <> "" Then
ShP.Range("A1").Value = Cells(i, FC).Value
If Fr = i Then
k = Fr + 2
Else
k = Fr
End If
GoTo Resum
End If
Next i
Resum:
For i = Fr To Lr
If Cells(i, FC).Interior.Color = 4697456 And Cells(i, FC).Value <> "" Then
If i > Fr Then
ShP.Cells(3 + i - k, 1).Value = Cells(i, FC).Value
End If
ElseIf Cells(i, FC + 1).Value <> "" Then
Range(ShP.Cells(3 + i - k, 2), ShP.Cells(3 + i - k, 1 + LC - FC)).Value = Range(Cells(i, FC + 1), Cells(i, LC)).Value
End If
Next i
L = i - 1
Set ws = ShP
j = ShP.Index
Sheets(j + 1).Visible = True
Sheets(j + 1).Select
n = Int((L - Fr + 1) / 32) + 1
Sheets(j + 1).PageSetup.PrintArea = Sheets(j + 1).Range("A1:H" & n * 34 + 6).Address
Printing: ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:="Print " & ShP.Range("A1").Value _
  , Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
   :=False, OpenAfterPublish:=True
Sheets(j + 1).Visible = False
ShP.Range("A1:A2").ClearContents
On Error Resume Next
Range(ShP.Cells(3, 2), ShP.Cells(L, 1 + LC - FC)).MergeArea.ClearContents
Range(ShP.Cells(3, 1), ShP.Cells(L, 1 + LC - FC)).ClearContents
DSheet.Select
Application.ScreenUpdating = True
End Sub
second code
Code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Long
    If Target.Column = 2 And Target.Row >= 67 Then
        If (Target.Row - 35) Mod 32 = 0 Then
                lRow = (((Target.Row - 35) * 34) / 32) + 7
                With ThisWorkbook.Sheets("Print")
                    .Range("A" & lRow & ":H" & lRow + 33).Copy .Range("A" & lRow + 34)
                    Sheets("Print").Visible = False
                    Application.ScreenUpdating = True
                    Application.EnableEvents = True
                End With
            End If
        End If
End Sub
 

Excel Facts

Add Bullets to Range
Select range. Press Ctrl+1. On Number tab, choose Custom. Type Alt+7 then space then @ sign (using 7 on numeric keypad)

Forum statistics

Threads
1,223,708
Messages
6,174,006
Members
452,542
Latest member
Bricklin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top