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
Please find the file link : https://we.tl/t-eZCR7SNRM2
Thanks
Raj
That one worked. Here is the adjusted code:
Best regards,
Trowa
WoW Amazing!
It's work perfect!
And I have one doubt! While copy the teams from sheet 2 to sheet 1 using =TRANSPOSE(Sheet2!A2:A4) functionality.i got one empty space. if in sheet 2 only one teams will available i got 2 empty space.Do you have any idea to overcome that issue.
Thanks in advance!
Regards,
Raj
When using the transpose function you should be getting a 0 for empty values. Yours doesn't show anything. I can replicate your sheet in 2 ways. By entering an apostrophe in the empty cell(s) on sheet2 or by adding a conditional formatting rule on sheet1 to give a 0 a white colored text. The adjusted code below counts the cells in range A2:A4 on Sheet2 which contain text. An apostrophe is considered text. Maybe you used a different way to get (an) empty cell(s) on Sheet1 as long as the teams on Sheet2 contain either a team name or are empty then the code performs as expected.
Here is the code:
Best regards,
Trowa
Thank you for helping me out. Greatly appreciate it.