close

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(quot;2quot;)
Set NewSheet = ThisWorkbook.Sheets(quot;NewSheetquot;)

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(quot;2quot;).Cells(i 10, j).Copy
Destination:=Worksheets(quot;NewSheetquot;).Cells(i 10 (LineCount - 1) * 66, j)
Worksheets(quot;2quot;).Cells(i 10, j).ColumnWidth =
Worksheets(quot;NewSheetquot;).Cells(i 10 (LineCount - 1) * 66, j).ColumnWidth
Next j
Worksheets(quot;2quot;).Cells(i 10, j).RowHeight =
Worksheets(quot;NewSheetquot;).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(quot;TEMPLATE.XLSquot;)

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?

quot;DMBquot; gt; wrote in message
...
gt; I need to make several copies of 64 rows from sheet 1 to sheet 2 including
gt; the formatting. the copy, rowheight, and the columnwidth functions are
gt; extremely slow. How would you do this with a collection object, or better
yet
gt; through the Excel database?
gt;
gt; Sub experiment()
gt; Dim NumberOfLines As Integer
gt; NumberOfLines = 3
gt; Dim ExistingSheet As Worksheet
gt; Dim NewSheet As Worksheet
gt; Set ExistingSheet = ThisWorkbook.Sheets(quot;2quot;)
gt; Set NewSheet = ThisWorkbook.Sheets(quot;NewSheetquot;)
gt;
gt; Dim i As Integer
gt; Dim j As Integer
gt; Dim LineCount As Integer
gt; For LineCount = 1 To NumberOfLines
gt; For i = 1 To 64
gt; For j = 1 To 13
gt; Worksheets(quot;2quot;).Cells(i 10, j).Copy
gt; Destination:=Worksheets(quot;NewSheetquot;).Cells(i 10 (LineCount - 1) * 66,
j)
gt; Worksheets(quot;2quot;).Cells(i 10, j).ColumnWidth =
gt; Worksheets(quot;NewSheetquot;).Cells(i 10 (LineCount - 1) * 66, j).ColumnWidth
gt; Next j
gt; Worksheets(quot;2quot;).Cells(i 10, j).RowHeight =
gt; Worksheets(quot;NewSheetquot;).Cells(i 10 (LineCount - 1) * 66, j).RowHeight
gt; Next i
gt; Next LineCount
gt;
gt; End Sub
found a similar posting that might help:quot;maybe something like this
Sub test()
Worksheets(quot;sheet1quot;).Range(quot;b3quot;).Copy
Worksheets(quot;sheet2quot;).Range(quot;g1:g5quot;).PasteSpecial xlFormats
End Sub
--
Gary

quot;Angelusquot; gt; wrote in
message ...
gt;
gt; Is there a way to use the format painter in VBA? I mean, basically
gt; copying all the formatting properties of one cell into another cell?
gt;
gt; Thank you in advance!
gt;
gt;
gt; --
gt; Angelus
gt; ------------------------------------------------------------------------
gt; Angelus's Profile:
gt; www.excelforum.com/member.php...oamp;userid=30721
gt; View this thread: www.excelforum.com/showthread...hreadid=503918
gt;
quot;DMBquot; gt; wrote in message
...
gt; I need to make several copies of 64 rows from sheet 1 to sheet 2 including
gt; the formatting. the copy, rowheight, and the columnwidth functions are
gt; extremely slow. How would you do this with a collection object, or better
yet
gt; through the Excel database?
gt;
gt; Sub experiment()
gt; Dim NumberOfLines As Integer
gt; NumberOfLines = 3
gt; Dim ExistingSheet As Worksheet
gt; Dim NewSheet As Worksheet
gt; Set ExistingSheet = ThisWorkbook.Sheets(quot;2quot;)
gt; Set NewSheet = ThisWorkbook.Sheets(quot;NewSheetquot;)
gt;
gt; Dim i As Integer
gt; Dim j As Integer
gt; Dim LineCount As Integer
gt; For LineCount = 1 To NumberOfLines
gt; For i = 1 To 64
gt; For j = 1 To 13
gt; Worksheets(quot;2quot;).Cells(i 10, j).Copy
gt; Destination:=Worksheets(quot;NewSheetquot;).Cells(i 10 (LineCount - 1) * 66,
j)
gt; Worksheets(quot;2quot;).Cells(i 10, j).ColumnWidth =
gt; Worksheets(quot;NewSheetquot;).Cells(i 10 (LineCount - 1) * 66, j).ColumnWidth
gt; Next j
gt; Worksheets(quot;2quot;).Cells(i 10, j).RowHeight =
gt; Worksheets(quot;NewSheetquot;).Cells(i 10 (LineCount - 1) * 66, j).RowHeight
gt; Next i
gt; Next LineCount
gt;
gt; End Sub

arrow
arrow
    全站熱搜
    創作者介紹
    創作者 software 的頭像
    software

    software

    software 發表在 痞客邦 留言(0) 人氣()