raulmadrid
New Member
- Joined
- Sep 25, 2014
- Messages
- 8
Hi all,
I am working on a task and need a macro to loop through Column A which contains numbers and copy the data in Columns B & C with a specific number in column A (please see the table below)
<tbody>
</tbody>
For example, I want to copy data in columns B & C with number 1 in column A and then paste in Columns D & E. Subsequently, the macro will copy data with number 2 then paste in Columns F & G and so forth.
I have found a code that identifies the group with number 2s and copy related data. But this code stops at number 2 only. (Sorry I have googled this code and lost track of where I got it from.)
As this task is urgent and I am not good at VBA, any help to solve this is greatly appreciated.
Looking forward to your replies...
Thank you.
I am working on a task and need a macro to loop through Column A which contains numbers and copy the data in Columns B & C with a specific number in column A (please see the table below)
Column A | Column B | Column C |
1 | a | aa |
2 | b | bb |
2 | b | bb |
2 | b | bb |
2 | b | bb |
3 | c | cc |
3 | c | cc |
<tbody>
</tbody>
For example, I want to copy data in columns B & C with number 1 in column A and then paste in Columns D & E. Subsequently, the macro will copy data with number 2 then paste in Columns F & G and so forth.
I have found a code that identifies the group with number 2s and copy related data. But this code stops at number 2 only. (Sorry I have googled this code and lost track of where I got it from.)
Code:
Sub ChooseRangeWithSpecificDataAndCopy()
Dim Lrow As Integer
Dim LColARange As String
Dim LContinue As Boolean
'Select Sheet1
Sheets("Sheet1").Select
Range("A2").Select
'Initialize variables
LContinue = True
Lrow = 2
'Loop through all column A values until a blank cell is found or value does not
' match cell A2's value
While LContinue = True
Lrow = Lrow + 1
LColARange = "A" & CStr(Lrow)
'Found a blank cell, do not continue
If Len(Range(LColARange).Value) = 0 Then
LContinue = False
End If
'Found first occurrence that did not match cell A2's value, do not continue
If Range("A2").Value <> Range("A" & CStr(Lrow)).Value Then
LContinue = False
End If
'Copy data from columns A - C
Range("B2:C" & CStr(Lrow - 1)).Copy
Range("E2").Select
ActiveSheet.Paste
Wend
MsgBox "Copy has completed."
End Sub
As this task is urgent and I am not good at VBA, any help to solve this is greatly appreciated.
Looking forward to your replies...
Thank you.
Last edited: