How to copy the Column value into Rows
Solved/Closed
Raj_1562
Posts
29
Registration date
Wednesday 26 August 2020
Status
Member
Last seen
29 August 2022
-
7 Sep 2020 à 03:36
TrowaD Posts 2921 Registration date Sunday 12 September 2010 Status Contributor Last seen 27 December 2022 - 14 Sep 2020 à 11:42
TrowaD Posts 2921 Registration date Sunday 12 September 2010 Status Contributor Last seen 27 December 2022 - 14 Sep 2020 à 11:42
Related:
- Used ccm tl
- Excel column number - Guide
- How to delete a column in word - Guide
- Tweetdeck expand column - Guide
- How to repeat rows in excel - Guide
- The following excel image has a vba program (see below). what will be the result after the program is executed? any cells not displayed are currently empty, and any cells with numbers are formatted numeric. sub afdo a=0 lastrow = cels(rows. count, 1). end(xdup). row for i =14 to lastrow step 2 a=a cellsii. 5) value next cells(lastrow 2, 1) value = "the sum - Guide
1 response
TrowaD
Posts
2921
Registration date
Sunday 12 September 2010
Status
Contributor
Last seen
27 December 2022
555
7 Sep 2020 à 11:49
7 Sep 2020 à 11:49
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
Best regards,
Trowa
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
7 Sep 2020 à 12:15
Amazing! It's working 100% as i'm expected way and THANKS for your quick response.
KEEP ROCKING!!
Regards,
Raj
8 Sep 2020 à 04:36
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
8 Sep 2020 à 11:44
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
8 Sep 2020 à 12:20
Please find the file link : https://we.tl/t-eZCR7SNRM2
Thanks
Raj
10 Sep 2020 à 11:11
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 SubBest regards,
Trowa