Copy Data to other sheet with some conditions
Dear Team,
I need your help to write a macro for this scenario I have
Actually as you can see in the attached excel, I have this kind of row data “sheet1”
And what I’m going to asking for :
1-How I can copy cells (A$, B$,E$) form each row to sheet2 “ n” times depending on number in the cell D$.
2-Taking in consideration that I must kept the first row in the two sheets as “columns heading”
3-And the cell E$ in sheet2 = the assembling of values in (E$,D$,G$ for n=1 and E$,D$,G$,H$ and E$,D$,G$,H$,I$ for n=3 if exist.
4-The Rest of cells in sheet2 will filled by another way
5-This process will apply for more than 10000 rows
The excel file is an example and sample written manually (copy/paste) and I hope to fill it automatically
Only by your support & thanks for any assistance
| Attachment | Size |
|---|---|
| Book3.xlsx | 8.73 KB |
Put the following code in a
Put the following code in a module and run.
Sub CopyData()
Dim rngSrcData As Range
Dim rngRow As Range
Dim wksTgt As Worksheet
Dim intCnt As Integer
Dim intTgtRow As Integer
Set wksTgt = Sheet2
With Sheet1.Range("A1")
Set rngSrcData = Intersect(.CurrentRegion, .CurrentRegion.Offset(1))
End With
For Each rngRow In rngSrcData.Rows
For intCnt = 1 To rngRow.Cells(, 4).Value
intTgtRow = wksTgt.Range("A1").CurrentRegion.Rows.Count + 1
wksTgt.Cells(intTgtRow, 1).Value = rngRow.Cells(, 1).Value
wksTgt.Cells(intTgtRow, 2).Value = rngRow.Cells(, 2).Value
wksTgt.Cells(intTgtRow, 5).Value = Left(rngRow.Cells(, 5), 1) & Mid(rngRow.Cells(, 5), 2) & rngRow.Cells(, 4) & rngRow.Cells(, 6 + intCnt)
Next intCnt
Next rngRow
Set rngSrcData = Nothing
Set rngRow = Nothing
Set wksTgt = Nothing
End Sub
I tried it & it seem working fine
Maybe my english not good enough to write a strong thanks words,
but I will say thanks a lot Vishesh.