Previous Topic Next Topic

Vb, how to copy values & repeat to next 50 cells

Closed
weenie Posts 9 Registration date Saturday July 3, 2010 Status Member Last seen May 5, 2016 - Jan 16, 2014 at 11:59 PM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 - Jan 20, 2014 at 10:56 AM
Hello,
Need help writing code @ step C & D
I am:
A) copying values in E1-E4 & transposing values
B) to Col. A next available empty row (obviously Col B-D at these rows will be empty also)
C) need it to copy (same info from step B) down next 50 rows
D) How to loop steps A-C

I don't want to hard code the Col & Row because I will be clearing contents in E1-E4 & moving over next set of data and repeating above steps A-C. I have data in Col E-Col EY.

Example
45
oven
0
500

NOW transposed
45 oven 0 500

??how do I repeat the transposed data to next 50 rows??

I have this code so far:
Range("E1:E4").Select
Selection.Copy
Range("A65536").End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
Application.CutCopyMode = False

????Need the repeat to 50 rows????

Range("E1:E4").Select
Selection.ClearContents
Range("F1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Cut
Range("E1").Select
ActiveSheet.Paste

??How do I loop Above???

Thanks,
Weenie

Related:

1 response

Answer 1 / 1
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Jan 20, 2014 at 10:56 AM
Hi Weenie,

The following code will loop through all used columns starting at E.
4 Rows of the respective column will be copied and transposed to the first available row in column A.
The 4 rows from the respective column will be cleared.
The transposed data will be repeated 49 times (covering row 2-51 for first batch). 

Sub RunMe()
Dim lCol, x, y As Integer

lCol = Range("E1").End(xlToRight).Column
x = 2
y = 51

For Each cell In Range(Cells(1, "E"), Cells(1, lCol))
    Range(cell, cell.Offset(3, 0)).Copy
    Range("A" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
    Range(cell, cell.Offset(3, 0)).ClearContents
    Range(Cells(x, "A"), Cells(x, "D")).Copy
    
    Do
        Range("A" & x + 1).PasteSpecial
        x = x + 1
    Loop Until x = y
    
    y = y + 50
    x = x + 1
Next cell

Application.CutCopyMode = False

End Sub

Best regards,
Trowa
0

Similar discussions

help me to add particular cells
mathewmunna -
mathew munna -

2 responses
Fill adjacent cell with number from text answer
MitchP -
vcoolio -

20 responses
Excel function question
1234ah -
ac3mark -

3 responses
Return Seq Values Until Blank value then return different set of seq values
lorieb63 -
TrowaD -

1 response
Condition formatting on changing cell color based on another cel
Saitoh7 -
Mazzaropi -

1 response