Copy Paste - Columns

[sekar_r24]

Hi.,

i am trying to copy & paste the range of columns to two columns with specified criteria., Attached herewith the code so far.
the table consist of 6 columns. the first four columns are code nos with corresponding value in the last two column. i am trying to populate the following.

1. first column to be placed in a certain location.
2. the second column to be placed below the first column.
3. the third column below the second column
4. the fourth column below the third column.
5. The value in the fifth column to be placed next column of the first column placed in sl.no:01
6. the same value is placed again below the values pasted in the sl.no:5.
7. The value in the sixth column to be placed below the sl.no:06
8. the same value (sixth column) is placed again below the values pasted in the sl.no:7

the code i tried below, able to achieve upto sl.no:6

Public Sub edgeband()
Dim x As Integer
Dim y As Integer ' column variable
Dim k As Integer ' column variable
Dim m As Integer ' column variable
Dim lngLastRow As Long
Dim lngLast As Long
m = 14
'to find the last row in the column.
'lry = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows,xlPrevious, False).Row
lngLastRow = Cells(Rows.Count, "F").End(xlUp).Row
 Z = 13 ' destination column
 x = 3 'row no
y = 6 ' column no
k = 3
' toclear the last row
For y = 6 To 9
Range(Cells(x, y), Cells(lngLastRow, y)).Copy
Cells(k, Z).PasteSpecial xlPasteValues ' destination column
k = Cells(Rows.Count, Z).End(xlUp).Row + 1
Next y
Z = Z + 1
k = 3
For m = m To m + 2
Range(Cells(k, y), Cells(lngLastRow, y)).Copy
Cells(k, Z).PasteSpecial xlPasteValues
k = Cells(Rows.Count, Z).End(xlUp).Row + 1
Cells(k, Z).PasteSpecial xlPasteValues
y = y + 1
m = m + 1
x = 3
k = Cells(Rows.Count, Z).End(xlUp).Row + 1
Next m
Application.CutCopyMode = False
End Sub

How to achieve the 7th and 8th?

EB-L1	EB-L2	EB-W1	EB-W2	EB-Length	EB-Width
A1	A2	A3	A4	462	550
A1	A1	A1	A1	562	550
A2	A2	A2	A2	612	550
A3	A4	A1	A2	912	295

EB	Length
A1	462
A1	562
A2	612
A3	912
A2	462
A1	562
A2	612
A4	912
A3	550
A1	550
A2	550
A1	295
A4	550
A1	550
A2	550
A2	295
A3	550
A1	550
A2	550
A1	295
A4	550
A1	550
A2	550
A2	295

Thanks

 

[Fluff]

How about

Public Sub edgeband()
Dim x As Integer, z As Long
Dim y As Integer ' column variable
Dim k As Integer ' column variable
Dim m As Integer ' column variable
Dim lngLastRow As Long
Dim lngLast As Long
m = 14
'to find the last row in the column.
'lry = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows,xlPrevious, False).Row
lngLastRow = Cells(Rows.Count, "F").End(xlUp).Row
 z = 13 ' destination column
 x = 3 'row no
y = 6 ' column no
k = 3
' toclear the last row
For y = 6 To 9
   Range(Cells(x, y), Cells(lngLastRow, y)).Copy
   Cells(k, z).PasteSpecial xlPasteValues ' destination column
   k = Cells(Rows.Count, z).End(xlUp).Row + 1
Next y
z = z + 1
k = 3
For m = m To m + 1
   Range(Cells(x, y), Cells(lngLastRow, y)).Copy
   Cells(k, z).PasteSpecial xlPasteValues
   k = Cells(Rows.Count, z).End(xlUp).Row + 1
   Cells(k, z).PasteSpecial xlPasteValues
   y = y + 1
   k = Cells(Rows.Count, z).End(xlUp).Row + 1
Next m
Application.CutCopyMode = False
End Sub

 

[Fluff]

A slightly slimmed down version.

Public Sub edgeband()
Dim x As Integer, z As Long
Dim y As Integer ' column variable
Dim k As Integer ' column variable
Dim m As Integer ' column variable
Dim lngLastRow As Long, Rws As Long

m = 10
'to find the last row in the column.
'lry = Cells.Find("*", Cells(1, 1), xlFormulas, xlPart, xlByRows,xlPrevious, False).Row
lngLastRow = Cells(Rows.Count, "F").End(xlUp).Row
 z = 13 ' destination column
 x = 3 'row no
 k = x
' toclear the last row
Rws = lngLastRow - x + 1
For y = 6 To 9
   Cells(k, z).Resize(Rws).Value = Cells(x, y).Resize(Rws).Value
   k = k + Rws
Next y
z = z + 1
k = x
For y = m To m + 1
   Cells(x, y).Resize(Rws).Copy
   Cells(k, z).Resize(Rws * 2).PasteSpecial xlPasteValues
   k = k + Rws * 2
Next y
Application.CutCopyMode = False
End Sub

 

[sekar_r24]

Thanks Fluff., works like a charm.
To get the sum of A1, A2, A3 & A4 separately, does autofilter -> Copy -> sum the values is the best way or any other wayaround?

 

[Fluff]

As that is a totally different question, you will need to start a new thread. Thanks

 

[sekar_r24]

Ok. Thanks