How to copy the Column value into Rows

Solved/Closed
Raj_1562 Posts 29 Registration date Wednesday August 26, 2020 Status Member Last seen August 29, 2022 - Sep 7, 2020 at 03:36 AM
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 - Sep 14, 2020 at 11:42 AM
Dear Experts,

I would like to copy the team name according to the image shown below.

For your reference i differentiate 3 combination but I would like to display 3 combination in one single



Thanks in advance!

Regards,
Raj

1 response

TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552
Updated on Sep 7, 2020 at 11:50 AM
Hi Raj,

I made an addition to the code I posted last time (https://ccm.net/forum/affich-1118956-auto-generate-serial-number-in-excel-based-on-input-value
Private Sub Worksheet_Change(ByVal Target As Range)
Dim mStep, NoR, x, y As Integer
If Intersect(Target, Range("G3")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False

mStep = WorksheetFunction.CountA(Range("C3:E3"))
NoR = Target.Value
x = 6

Range("A6:C" & Rows.Count).ClearContents

For y = NoR To 1 Step -1
    Range("C3:E3").Copy
    Range("C" & Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial Transpose:=True
Next y

Do
    y = y + 1
    Cells(x, "A").Value = y
    x = x + mStep
    NoR = NoR - 1
Loop Until NoR = 0

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub


Best regards,
Trowa

Raj_1562 Posts 29 Registration date Wednesday August 26, 2020 Status Member Last seen August 29, 2022
Updated on Sep 7, 2020 at 12:17 PM
Hi TrowaD,

Amazing! It's working 100% as i'm expected way and THANKS for your quick response.

KEEP ROCKING!!

Regards,
Raj
0
Raj_1562 Posts 29 Registration date Wednesday August 26, 2020 Status Member Last seen August 29, 2022
Sep 8, 2020 at 04:36 AM
Hi TrowaD,

Sorry for the inconvenience!

The above code working fine in Excel sheet.

I have tried the same logic in my Original file the team value doesn't copied.because of we have used table.So, the value not updating in table.

I have uploaded the file following link: https://drive.google.com/file/d/1BwVIiN3zYnmIflEWWwYNvX9-fNHA0-7K/view?usp=sharing


Thanks,
Raj
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552 > Raj_1562 Posts 29 Registration date Wednesday August 26, 2020 Status Member Last seen August 29, 2022
Sep 8, 2020 at 11:44 AM
Hi Raj,

I can't seem to acces your file. Others have used Google drive before, so it should be possible. You can also try to use other free filesharing ways (just keep in mind that I won't sign up for anything)

Best regards,
Trowa
0
Raj_1562 Posts 29 Registration date Wednesday August 26, 2020 Status Member Last seen August 29, 2022 > TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022
Updated on Sep 8, 2020 at 12:21 PM
Hi Trowa,

Please find the file link : https://we.tl/t-eZCR7SNRM2

Thanks
Raj
0
TrowaD Posts 2921 Registration date Sunday September 12, 2010 Status Moderator Last seen December 27, 2022 552 > Raj_1562 Posts 29 Registration date Wednesday August 26, 2020 Status Member Last seen August 29, 2022
Sep 10, 2020 at 11:11 AM
Hi Raj,

That one worked. Here is the adjusted code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim mStep, NoR, x, y, rID As Integer

If Intersect(Target, Range("K3")) Is Nothing Then Exit Sub
Application.ScreenUpdating = False

mStep = WorksheetFunction.CountA(Range("H3:J3"))
NoR = Target.Value
rID = Range("E5").Value
x = 9

Range("B9:C" & Rows.Count).ClearContents
Range("H9:H" & Rows.Count).ClearContents

For y = NoR To 1 Step -1
    Range("H3:J3").Copy
    Range("H343").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues, Transpose:=True
Next y

Do
    y = y + 1
    Cells(x, "B").Value = y
    Cells(x, "C").Value = rID
    x = x + mStep
    NoR = NoR - 1
Loop Until NoR = 0

Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub


Best regards,
Trowa
0