Increasing row select number in a macro 1

[Curiousintel]

I am trying to set up an excel sheet that can pick up a row and copy it to a another static row that is linked to a formatted print area.
Each row is individually copied and pasted down to the static row in succession for a range of rows.

What i need is firstly a way of increasing the row number picked up until a predfined row number is reached and also a way of picking up a cell reference in excel that tells the macro the range of rows to be copied and pasted.

I have the macro at present creating a new excel file and renaming the tabs to correspond with each row printed but the proceedure is cumbersome if the row range is changed.

 

[Chance1234]

post up your code,

Filmmaker, gentleman and Ambasador for London to the sticks.

http://WWW.5YLAC.S5.COM

 

[Curiousintel]

This is a snippet of the code as it has to work for about 100 rows and repeats each section to create tabs and copy and paste the rows.

Sub Autocreate()
'
' Autocreate Macro
'

'
Workbooks.Add
ActiveWorkbook.SaveAs Filename:= _
"Q:\PAUL-KEN\STATISTICS\STATISTICS 2004\Incentives 2004\Export.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False

Sheets("Sheet3").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Sheet2").Select
ActiveWindow.SelectedSheets.Delete

Sheets("Sheet1").Select
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.4)
.BottomMargin = Application.InchesToPoints(0.4)
.HeaderMargin = Application.InchesToPoints(0.22)
.FooterMargin = Application.InchesToPoints(0.22)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 90
.PrintErrors = xlPrintErrorsDisplayed
End With


Sheets("Sheet1").Name = "3"
Sheets("3").Copy After:=Sheets("3")
Sheets("3 (2)").Name = "4"
Sheets("3").Copy After:=Sheets("4")
Sheets("3 (2)").Name = "5"
Sheets("3").Copy After:=Sheets("5")
Sheets("3 (2)").Name = "6"

Windows("Staff Incentive Spring Party.xls").Activate
Rows("31:31").Select
Selection.Copy
Rows("108:108").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A133:N166").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Windows("Export.xls").Activate
Sheets("3").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False


Windows("Staff Incentive Spring Party.xls").Activate
Rows("32:32").Select
Selection.Copy
Rows("108:108").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A133:N166").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Windows("Export.xls").Activate
Sheets(4").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False


Sheets("3").Select


End Sub

 

[Chance1234]

bear with us have a meeting to attend

Filmmaker, gentleman and Ambasador for London to the sticks.

http://WWW.5YLAC.S5.COM

 

[Chance1234]

urgh this is messy but, the below code copies a 100 rows only from sheet1 and pastes them in sheet2

int_row_cnt is used as a counter and the code will stop copying when that counter reaches a 100 , it is also used to identify the row

Sub tst()
Dim int_Row_cnt As Integer


int_Row_cnt = 1

Do Until int_Row_cnt = 100


    Worksheets("Sheet1").Cells(int_Row_cnt, 1).Select
    
    Selection.EntireRow.Copy Destination:=Worksheets("Sheet2").Cells(int_Row_cnt, 1).EntireRow
    
    int_Row_cnt = int_Row_cnt + 1

Loop

End Sub

Filmmaker, gentleman and Ambasador for London to the sticks.

http://WWW.5YLAC.S5.COM

 

[Curiousintel]

Forgive the messy code, i'm very new to this.

What you've given me is very close but i need to paste each row to the *same new row* everytime, then it gets copied from there to a new tab on a another workbook all within the same loop. Then the process is to be repeated for each row in the count.

Also i need a way of picking up the count range from the spreadsheet so that the amount of row repeats can be input in a cell on the worksheet and picked up by the macro.
Thanks

 

[Chance1234]

Sub tst()
Dim int_Row_cnt As Integer
Dim int_buffer As Integer

int_Row_cnt = 1
int_buffer = Worksheets("sheet3").Range("A1").Value 'the cell with your value in
Do Until int_Row_cnt = int_buffer

    Worksheets("Sheet1").Cells(int_Row_cnt, 1).Select
    
    Selection.EntireRow.Copy Destination:=Worksheets("Sheet2").Cells(1, 1).EntireRow ' change to whatever row
    
    int_Row_cnt = int_Row_cnt + 1

Loop

End Sub

was refering to my own code on the messy ;-)

Filmmaker, gentleman and Ambasador for London to the sticks.

http://WWW.5YLAC.S5.COM

 

[Curiousintel]

You might think your code is messy but its just reduced my nightmare of constantly changing rows within macros on about 20 spreadsheets.

Thank you very much

 

[Chance1234]

no problemo do feel free to give us a star

Filmmaker, gentleman and Ambasador for London to the sticks.

http://WWW.5YLAC.S5.COM

 

[Curiousintel]

Sorry chance1234 if you are still following this thread I have a followup relating to the code.

I am using your system to also change the tab name on the newly copied worksheet to increase each tab name by one. But what am i doing wrong as the variable int_sheet is copied then renamed original tab + 1

Error is in red further down




Sub Autocreate()
'
' Autocreate Macro
' Macro recorded 24/03/2004 by Kenneth Smyth
'

'

Dim int_Row_cnt As Integer
Dim int_buffer As Integer
Dim int_sheet As Integer

Windows("Staff Incentive Spring Party.xls").Activate
int_Row_cnt = Worksheets("Sheet1").Range("B6").Value 'the cell with your value in
int_buffer = Worksheets("Sheet1").Range("D6").Value 'the cell with your value in
int_sheet = Worksheets("Sheet1").Range("B108").Value 'the cell with your value in3

Workbooks.Add
ActiveWorkbook.SaveAs Filename:= _
"Q:\PAUL-KEN\STATISTICS\STATISTICS 2004\Incentives 2004\Export.xls", FileFormat:=xlNormal, _
Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False

Sheets("Sheet3").Select
ActiveWindow.SelectedSheets.Delete
Sheets("Sheet2").Select
ActiveWindow.SelectedSheets.Delete

Sheets("Sheet1").Select
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.4)
.BottomMargin = Application.InchesToPoints(0.4)
.HeaderMargin = Application.InchesToPoints(0.22)
.FooterMargin = Application.InchesToPoints(0.22)
.PrintHeadings = False
.PrintGridlines = False
.PrintComments = xlPrintNoComments
.PrintQuality = 600
.CenterHorizontally = False
.CenterVertically = False
.Orientation = xlLandscape
.Draft = False
.PaperSize = xlPaperA4
.FirstPageNumber = xlAutomatic
.Order = xlDownThenOver
.BlackAndWhite = False
.Zoom = 90
.PrintErrors = xlPrintErrorsDisplayed
End With


Do Until int_Row_cnt = int_buffer + 1


Windows("Staff Incentive Spring Party.xls").Activate
Worksheets("Sheet1").Cells(int_Row_cnt, 1).Select
Selection.EntireRow.Copy
Rows("108:108").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A133:N166").Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy

Windows("Export.xls").Activate
Sheets("Sheet1").Name = int_sheet
Sheets(int_sheet).Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False


int_Row_cnt = int_Row_cnt + 1
int_sheet = int_sheet + 1

Loop



End Sub

 

[PHV]

Try this:
Sheets(CStr(int_sheet)).Select

Hope This Help, PH.
Want to get great answers to your Tek-Tips questions? Have a look at FAQ219-2884

 

[Curiousintel]

Thats good PHV can you tell me the code for the second sheet after i copy the first
eg
sheets(Cstr(int_sheet)(2)).select ?

sheet names will be 3,4,5,6,7, etc

remember i need to go back to the original int_sheet each time and copy until there are enough copies but as each one is copied i need to paste data to them so i also need a way of ascertaining a link to the new copied sheet each time.
Thanks

 

[Chance1234]

Tell you what CuriousIntel is it might be worth yourself do some reading on referencing objects in excel. a good search of google and the help files will help there.

also im not going to tell you the answer to the above, because i think you already know, though i will give you a clue think about this int_sheet = int_sheet + 1

Filmmaker, gentleman and Ambasador for London to the sticks.

http://WWW.5YLAC.S5.COM

 

[KenWright]

You should also take a look at With / End With constructs, eg:-

With ActiveWorkbook
Sheets("Sheet3").Delete
Sheets("Sheet2").Delete
End With

One example of this is in the ActiveSheet.PageSetup section of code you have in there, although wrt this you only actually need to use the options that won't be the default, eg maybe just:-

With ActiveSheet.PageSetup
.LeftMargin = Application.InchesToPoints(0.25)
.RightMargin = Application.InchesToPoints(0.25)
.TopMargin = Application.InchesToPoints(0.4)
.BottomMargin = Application.InchesToPoints(0.4)
.HeaderMargin = Application.InchesToPoints(0.22)
.FooterMargin = Application.InchesToPoints(0.22)
End With

You should also avoid selecting like the plague where you can, eg:-

Range("A133:N166").SpecialCells(xlCellTypeVisible).Copy

Regards
Ken.................

----------------------------------------------------------------------------
It's easier to beg forgiveness than ask permission

----------------------------------------------------------------------------

 

[Curiousintel]

Thanks KenWright good to have a few tips on making my code cleaner.
Got it to work over the weekend with all the variables able to be changed in set input cells in a sheet.
Only have the problem now of picking up the path of the files which i want the user to type in a cell in an excel sheet - any ideas?

I'll post the finished code later if interested.