VBA code - print report of multiple sheets

[secoo140]

Private Sub btnTedavi_Click()

Dim cikti As Worksheet, doz As Worksheet, kanlar As Worksheet, TutulumP As Worksheet
Set cikti = ThisWorkbook.Sheets("cikti")
Set doz = ThisWorkbook.Sheets("doz")
Set kanlar = ThisWorkbook.Sheets("kanlar")
Set TutulumP = ThisWorkbook.Sheets("Tutulum Paterni")


If doz.Cells(Rows.Count, 1).End(xlUp).Row = 1 Then
    dozLR = 2
Else
    dozLR = doz.Cells(Rows.Count, 1).End(xlUp).Row
End If


If kanlar.Cells(Rows.Count, 1).End(xlUp).Row = 1 Then
    kanlarLR = 2
Else
    kanlarLR = kanlar.Cells(Rows.Count, 1).End(xlUp).Row
End If






cikti.Range("a2:z" & dozLR).ClearContents
'son raporu silmeye yarar




Y = 2 'başlanacak sütun


For X = 2 To dozLR
     cikti.Cells(Y, 1) = doz.Cells(X, 1)
     cikti.Cells(Y, 2) = CDate(doz.Cells(X, 2))
     cikti.Cells(Y, 3) = doz.Cells(X, 3)
     cikti.Cells(Y, 4) = doz.Cells(X, 4)
     Y = Y + 1
     
Next X


Y = Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select


For X = 2 To kanlarLR
    cikti.Cells(Y, 1) = kanlar.Cells(X, 1)
    cikti.Cells(Y, 2) = kanlar.Cells(X, 2)
    cikti.Cells(Y, 3) = kanlar.Cells(X, 3)
Next X


Application.ScreenUpdating = True
Worksheets("cikti").Select
Me.Hide




If PrintF.cbOnizle = True Then
    cikti.PrintPreview
End If




End Sub

there is 4 sheets with listed data, I want to create a report page and print it.

I can copy and print a page, but not multiple pages.

I want to copy all existing rows in an order.


thanks.

 

[ravishankar]

your requirement is not clear. you can try the following codes which summarizes all non-blank sheets into a summary sheet with corresponding sheet names in column A. Hope that helps.

Sub secoo140()
Dim a As Integer, x As Integer
Sheets.Add.Name = "summary"
For a = 1 To Sheets.Count
If Sheets(a).Cells(Rows.Count, 1).End(xlUp).Row > 1 Then
Sheets(a).UsedRange.Copy
x = Sheets("summary").Cells(Rows.Count, 2).End(xlUp).Row + 2
Sheets("summary").Range("A" & x - 1) = Sheets(a).Name
Sheets("summary").Range("B" & x).PasteSpecial
End If
Next a
MsgBox "complete"
End Sub

ravishankar

 

[secoo140]

Problem solved.
thanks.