copying and printing excel rows

  peug417 15:10 28 Oct 07
Locked

copying and printing rows

I have a excel worksheet which has static information in the rows 1 - 15,Then dynamic weekly information in rows 16 - 535 in steps of 10.
ie week 1 = rows 16 - 25 week 2 is 26-35 etc.
The issue I have is to be able to print the static info along with 1 weeks info. so for week 17 i would need to print rows 1 - 15 and 176 - 185. I did this sort of thing in anonther project which had a hidden sheet with the static info and the dynamic info was copied acoss.

The problem is for different users the number of colums will be different, ie some users will only have 5 cols of info some could have in excess of 150.

hope this makes sense...

  VoG II 16:00 28 Oct 07

Try this macro - it has to be run with the sheet to be printed selected:

Sub PrtWk()
Dim wkno As Integer, startrow As Long, endrow As Long
Dim userResponse As Variant, lastcol As Integer
Dim insht As Worksheet, prtsht As Worksheet
userResponse = Application.InputBox(Prompt:="Enter week number", Type:=1)
If userResponse = "False" Then Exit Sub
Application.ScreenUpdating = False
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
Set insht = ActiveSheet
Sheets.Add after:=Worksheets(Worksheets.Count)
Set prtsht = ActiveSheet
wkno = Val(userResponse)
startrow = 6 + 10 * wkno
endrow = startrow + 9
insht.Range(insht.Cells(1, 1), insht.Cells(15, lastcol)).Copy Destination:=prtsht.Range("A1")
insht.Range(insht.Cells(startrow, 1), insht.Cells(endrow, lastcol)).Copy Destination:=prtsht.Range("A16")
Application.CutCopyMode = False
prtsht.PrintOut
Application.DisplayAlerts = False
prtsht.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

  peug417 16:42 28 Oct 07

Another work of art VOG.
Works perfectly bar one hiccup
I changed the Printout line to PrintPreview, which saved me printing 29 pages. It is not copying the Rows at their current set heights. its distorting the fist 15 rows and showing rows 6,8,10,12 & 14 which are hidden rows.

sorry to be a pain

  VoG II 17:11 28 Oct 07

Sub PrtWk()
Dim wkno As Integer, startrow As Long, endrow As Long
Dim userResponse As Variant, lastcol As Integer
Dim j As Integer, k As Integer, h As Variant
Dim insht As Worksheet, prtsht As Worksheet
userResponse = Application.InputBox(Prompt:="Enter week number", Type:=1)
If userResponse = "False" Then Exit Sub
Application.ScreenUpdating = False
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
Set insht = ActiveSheet
Sheets.Add after:=Worksheets(Worksheets.Count)
Set prtsht = ActiveSheet
wkno = Val(userResponse)
startrow = 6 + 10 * wkno
endrow = startrow + 9
k = 0
For j = 1 To 15
If Not insht.Rows(j).Hidden Then
k = k + 1
insht.Range(insht.Cells(j, 1), insht.Cells(j, lastcol)).Copy Destination:=prtsht.Range("A" & k)
prtsht.Rows(k).RowHeight = insht.Rows(j).RowHeight
End If
Next j
k = k + 1
insht.Range(insht.Cells(startrow, 1), insht.Cells(endrow, lastcol)).Copy Destination:=prtsht.Range("A" & k)
Application.CutCopyMode = False
prtsht.PrintPreview
Application.DisplayAlerts = False
prtsht.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

  peug417 17:26 28 Oct 07

Nice one mate, irows are now correct, just the Icols now, If its any help col A is 30,col B is 6, col C is 10,col D is 27 & COL E to last col is 5.

  VoG II 17:37 28 Oct 07

Sub PrtWk()
Dim wkno As Integer, startrow As Long, endrow As Long
Dim userResponse As Variant, lastcol As Integer
Dim j As Integer, k As Integer, ic As Integer
Dim insht As Worksheet, prtsht As Worksheet
userResponse = Application.InputBox(Prompt:="Enter week number", Type:=1)
If userResponse = "False" Then Exit Sub
Application.ScreenUpdating = False
lastcol = Cells(1, Columns.Count).End(xlToLeft).Column
Set insht = ActiveSheet
Sheets.Add after:=Worksheets(Worksheets.Count)
Set prtsht = ActiveSheet
wkno = Val(userResponse)
startrow = 6 + 10 * wkno
endrow = startrow + 9
k = 0
For j = 1 To 15
If Not insht.Rows(j).Hidden Then
k = k + 1
insht.Range(insht.Cells(j, 1), insht.Cells(j, lastcol)).Copy Destination:=prtsht.Range("A" & k)
prtsht.Rows(k).RowHeight = insht.Rows(j).RowHeight
End If
Next j
k = k + 1
insht.Range(insht.Cells(startrow, 1), insht.Cells(endrow, lastcol)).Copy Destination:=prtsht.Range("A" & k)
Application.CutCopyMode = False
For ic = 1 To lastcol
prtsht.Columns(ic).ColumnWidth = insht.Columns(ic).ColumnWidth
Next ic
prtsht.PrintPreview
Application.DisplayAlerts = False
prtsht.Delete
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

  peug417 19:41 28 Oct 07

I have put the new code in and get an error printing, stepping through the code the following is the causing the issue.
insht.Range(insht.Cells(j, 1), insht.Cells(j, lastcol)).Copy Destination:=prtsht.Range("A" & k)
hovering over lastrow it came out as 3 before & now is 1. would it help for me to send the sheet over to you??

  VoG II 20:03 28 Oct 07

You can click my yellow envelope if you wish but first try saving the file, re-opening it and running the code again. Note that line of code worked in the previous version.

  peug417 20:13 28 Oct 07

I cured that issue by changing the following lastcol = Cells(1, Columns.Count).End(xlToLeft).Column to the following: lastcol = Cells(2, Columns.Count).End(xlToLeft).Column
The next issue i have id the page orientation of the prtsheet. I have put the following code into the prwk routine:
With ActiveSheet.PageSetup
.Orientation = xlLandscape
End With
This works though I need to put a code to set the printa area or page break. some of the users will need to have two or three sheets with range A1:c15 being repeated..

  VoG II 20:20 28 Oct 07

So presumably the error occurred because you tried it on a sheet with nothing in row 1.

What I suggest that you do is comment out this line, i.e. add an apostrophe as shown:

'prtsht.Delete

You can work on the prtsht sheet and record macros to find the best way of handling page breaks and so on. However I suggest that you modify code like

With ActiveSheet.PageSetup

to

With prtsht.PageSetup

(you never know - you might end up adding another sheet which would become the ActiveSheet and the code could then fall over or at best do something unexpected).

  VoG II 22:50 29 Oct 07

Having now seen the sheet and realised that A4&B4 were merged (bad news for VBA programmers), also that rows 4 to 15 contain formulas (I didn't know that) and rows 1

This thread is now locked and can not be replied to.

Surface Pro (2017) vs Surface Pro 4

20 groundbreaking 3D animation techniques

How to mine Bitcoin on Mac