I need to make several copies of 64 rows from sheet 1 to sheet 2 including
the formatting. the copy, rowheight, and the columnwidth functions are
extremely slow. How would you do this with a collection object, or better yet
through the Excel database?

Sub experiment()
Dim NumberOfLines As Integer
NumberOfLines = 3
Dim ExistingSheet As Worksheet
Dim NewSheet As Worksheet
Set ExistingSheet = ThisWorkbook.Sheets("2")
Set NewSheet = ThisWorkbook.Sheets("NewSheet")

Dim i As Integer
Dim j As Integer
Dim LineCount As Integer
For LineCount = 1 To NumberOfLines
For i = 1 To 64
For j = 1 To 13
Worksheets("2").Cells(i + 10, j).Copy
Destination:=Worksheets("NewSheet").Cells(i + 10 + (LineCount - 1) * 66, j)
Worksheets("2").Cells(i + 10, j).ColumnWidth =
Worksheets("NewSheet").Cells(i + 10 + (LineCount - 1) * 66, j).ColumnWidth
Next j
Worksheets("2").Cells(i + 10, j).RowHeight =
Worksheets("NewSheet").Cells(i + 10 + (LineCount - 1) * 66, j).RowHeight
Next i
Next LineCount

End Sub

If you know how to copy over the merging information also please let me know.

I found this function in the help but I haven't altered it yet and I expect
that it will slow my code down even more.

ActiveWorkbook.Styles.Merge Workbook:=Workbooks("TEMPLATE.XLS")

Theres also the merge area, mergecells, and merge functions / properities
which I will probebly need to use to accomplish this task. Is there a better
way to accomplish all of this through the database?

If your not adding to pre-existing data on Sheet2, it might be faster to
duplicate the entire sheet1 then remove the unneccessary rows and add
whatever is neccessary for sheet2.

Either way, I ususally jot down sheet1's formating, row heights, etc and
re-apply once sheet2 is processed rather than copier which should also be
faster?

"DMB" wrote in message
...
I need to make several copies of 64 rows from sheet 1 to sheet 2 including
the formatting. the copy, rowheight, and the columnwidth functions are
extremely slow. How would you do this with a collection object, or better
yet
through the Excel database?

Sub experiment()
Dim NumberOfLines As Integer
NumberOfLines = 3
Dim ExistingSheet As Worksheet
Dim NewSheet As Worksheet
Set ExistingSheet = ThisWorkbook.Sheets("2")
Set NewSheet = ThisWorkbook.Sheets("NewSheet")

Dim i As Integer
Dim j As Integer
Dim LineCount As Integer
For LineCount = 1 To NumberOfLines
For i = 1 To 64
For j = 1 To 13
Worksheets("2").Cells(i + 10, j).Copy
Destination:=Worksheets("NewSheet").Cells(i + 10 + (LineCount - 1) * 66,
j)
Worksheets("2").Cells(i + 10, j).ColumnWidth =
Worksheets("NewSheet").Cells(i + 10 + (LineCount - 1) * 66, j).ColumnWidth
Next j
Worksheets("2").Cells(i + 10, j).RowHeight =
Worksheets("NewSheet").Cells(i + 10 + (LineCount - 1) * 66, j).RowHeight
Next i
Next LineCount

End Sub

found a similar posting that might help:


"maybe something like this
Sub test()
Worksheets("sheet1").Range("b3").Copy
Worksheets("sheet2").Range("g1:g5").PasteSpecial xlFormats
End Sub
--
Gary

"Angelus" wrote in
message ...

Is there a way to use the format painter in VBA? I mean, basically
copying all the formatting properties of one cell into another cell?

Thank you in advance!


--
Angelus
------------------------------------------------------------------------
Angelus's Profile:
http://www.excelforum.com/member.php...o&userid=30721
View this thread: http://www.excelforum.com/showthread...hreadid=503918




"DMB" wrote in message
...
I need to make several copies of 64 rows from sheet 1 to sheet 2 including
the formatting. the copy, rowheight, and the columnwidth functions are
extremely slow. How would you do this with a collection object, or better
yet
through the Excel database?

Sub experiment()
Dim NumberOfLines As Integer
NumberOfLines = 3
Dim ExistingSheet As Worksheet
Dim NewSheet As Worksheet
Set ExistingSheet = ThisWorkbook.Sheets("2")
Set NewSheet = ThisWorkbook.Sheets("NewSheet")

Dim i As Integer
Dim j As Integer
Dim LineCount As Integer
For LineCount = 1 To NumberOfLines
For i = 1 To 64
For j = 1 To 13
Worksheets("2").Cells(i + 10, j).Copy
Destination:=Worksheets("NewSheet").Cells(i + 10 + (LineCount - 1) * 66,
j)
Worksheets("2").Cells(i + 10, j).ColumnWidth =
Worksheets("NewSheet").Cells(i + 10 + (LineCount - 1) * 66, j).ColumnWidth
Next j
Worksheets("2").Cells(i + 10, j).RowHeight =
Worksheets("NewSheet").Cells(i + 10 + (LineCount - 1) * 66, j).RowHeight
Next i
Next LineCount

End Sub