VBA Code Loop Copy Paste Transpose

Jeanpierre

New Member
Joined
Jul 13, 2021
Messages
11
Office Version
  1. 365
Platform
  1. Windows
Good day, I am newish to Visual Basic, apologies if this has been posted but i have searched through most of the forums and could not find this specific one. Basically what I need to do is a data sort from a file that information is not aligned properly.

It comes with information in Cell A, Cell B, Cell C, then Cell C2 (this cell needs to be text to column, comma sorted and then transposed), which I need to put in Cell A Cell B and Cell C.
The first part is easy, create a new data page, change data into columns (not sure if can avoid this step) as below:

VBA Code:
Columns("C:C").Select
    Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=True, Space:=False, Other:=False, FieldInfo _
        :=Array(Array(1, 2), Array(2, 2), Array(3, 2), Array(4, 2), Array(5, 2)), TrailingMinusNumbers:=True
    Sheets.Add After:=ActiveSheet
    Sheets("Sheet1").Select
    Sheets("Sheet1").Name = "Data Output"
    Sheets("Demo").Select
    Range("C1").Select
    Sheets("Data Output").Select
    ActiveCell.FormulaR1C1 = "Cell A"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Cell B"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Cell C"
    Range("A2").Select
    Sheets("Demo").Select
    Range("B1").Select
    Selection.Copy
    Sheets("Data Output").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

Now i need to copy and paste the data from the demo sheet neatly into data output sheet but the cells in C2 need to be copied and transposed on data output sheet and then this code needs to be looped for every repeat of cell C1 & Cell C2 till no data in column C.

VBA Code:
   Range("B2").Select
    Sheets("Demo").Select
    Range("C1").Select
    Selection.Copy
    Sheets("Data Output").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("C2").Select
    Sheets("Demo").Select
    Range("C2:V2").Select
    Selection.Copy
    Sheets("Data Output").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("B2").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("B3:B5").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("A1").Select
  
  Application.CutCopyMode = False

Images attached shows before and after, so I just need to loop it, and the code above might be primitive to the professionals, done with recording. Thank you.
VBA Code:
 

Attachments

  • image2.jpg
    image2.jpg
    97 KB · Views: 59
  • image1.jpg
    image1.jpg
    110 KB · Views: 62

Excel Facts

Can you AutoAverage in Excel?
There is a drop-down next to the AutoSum symbol. Open the drop-down to choose AVERAGE, COUNT, MAX, or MIN
Welcome to the MrExcel board!

Can you show us more of the expected results sheet?
 
Upvote 0
Ok, without being able to test any data thus far, I think the following shortened code will handle the first section of code:

VBA Code:
'   Destination Range, DataType, FieldInfo, TrailingMinusNumbers ... the '2' in the arrays = xlTextFormat
'   Defaults are: ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False, Space:=False, Other:=False
'
    ActiveSheet.Range("C:C").TextToColumns , Range("C1"), xlDelimited, xlDoubleQuote, , True, , True, , , _
        FieldInfo:=Array(Array(1, xlTextFormat), Array(2, xlTextFormat), Array(3, xlTextFormat), Array(4, xlTextFormat), Array(5, xlTextFormat)), _
        TrailingMinusNumbers:=True
'
    Sheets.Add(After:=ActiveSheet).Name = "Data Output"
'
    Range("A1").FormulaR1C1 = "Cell A"                      ' Write "Cell A" to cell A1 on Sheet 'Data Output'
    Range("B1").FormulaR1C1 = "Cell B"                      ' Write "Cell B" to cell B1 on Sheet 'Data Output'
    Range("C1").FormulaR1C1 = "Cell C"                      ' Write "Cell C" to cell C1 on Sheet 'Data Output'
'
    Sheets("Demo").Range("B1").Copy Sheets("Data Output").Range("A2")   ' Copy Range("B1") from the 'Demo' sheet to Range("A2") on sheet 'Data Output"
 
Upvote 0
Good day Gentlemen, thank you for response, apologies for delay, will try out the code thank you Johnny appreciate it.

testfile001.xlsx
ABC
1Cell 122445778322445786
25050004454,55447778866,5544478993,5555552247
322445786
45050004454,55447778866,5544478993,5555552247
522445786
65050004454,55447778866,5544478993,5555552247
722445786
85050004454,55447778866,5544478993,5555552247
9Cell 222445778422445787
105050004455,55447778865,5544478924,5555552244
1122445787
125050004455,55447778865,5544478924,5555552244
1322445787
145050004455,55447778865,5544478924,5555552244
1522445787
165050004455,55447778865,5544478924,5555552244
Demo


So this is sheet 1, below is how it needs to pop out:

testfile001_step1.xlsx
ABC
1Cell ACell BCell C
2224457783224457865050004454
32244578655447778866
4224457865544478993
5224457865555552247
Data Output


So cell c, might run up to 1000 lines etc, it may only be 20. So with the short ones its easy, but if need to repeat it gets tedious. So basically it must just run until cell c comes to blank cell, but must put data onto new sheet every 4 rows.
 
Upvote 0
Can you show us more of the expected results sheet?
The expected results are still not clear to me.

Will the next 4 rows of results be
- the same as rows 2-5 shown above since there are 4 sets of identical rows for 224457783 in the Demo sheet, or
- move straight on to 224457784 at row 9 of the Demo sheet?
 
Upvote 0
Yes sorry, so cell structure on output file must be:

B1 (demo) to A2 (data output), C1 (demo) to B2 (data output) then this must be copied down to B5, then C2 (demo) to C2 (data output) transpose up to C5, then repeat loop,

will then take B1 (demo) to A6 (data output), C3 (demo) to B6 (data output) copy down to B9, C4 (demo) to C6 (data output) transpose to C9, then repeat until cell c (demo) is blank.

If sheet is small its easy to run like a manual script, but cannot find a the loop code to do this.
 
Upvote 0
So cell c, might run up to 1000 lines etc, it may only be 20. So with the short ones its easy, but if need to repeat it gets tedious. So basically it must just run until cell c comes to blank cell, but must put data onto new sheet every 4 rows.
New sheet after every 4th row? That would be 250 sheets if you have 1000 lines of C.
 
Upvote 0
Since there is still confusion of what the sample output would look like, Is the following what the goal is:

Book1
ABC
1Cell ACell BCell C
2224457783224457865050004454
32244578655447778866
4224457865544478993
5224457865555552247
6224457865050004454
72244578655447778866
8224457865544478993
9224457865555552247
10224457865050004454
112244578655447778866
12224457865544478993
13224457865555552247
14224457865050004454
152244578655447778866
16224457865544478993
17224457865555552247
18224457784224457875050004455
19224457875050004455
20224457875050004455
21224457875050004455
22224457875050004455
23224457875050004455
24224457875050004455
25224457875050004455
26224457875050004455
27224457875050004455
28224457875050004455
29224457875050004455
30224457875050004455
31224457875050004455
32224457875050004455
33224457875050004455
Data Output


??? Its not formatted properly, but is that the jist of it @Jeanpierre ?
 
Upvote 0

Forum statistics

Threads
1,215,200
Messages
6,123,611
Members
449,109
Latest member
Sebas8956

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top