Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 57
  • Last Modified:

Excel 2013 VBA - Arrange data from two rows to one

Dear Experts,

Could you please have a look to the attached file on 'Sheet1', basically I have data in the following format so being in separate lines:
Data in two lines
Could you please advise which VBA code could arrange it as having on the 'Target' sheet, so placing each second line to column B?
Data arranged in one line
Thanks in advance,
TwoLinesExample.xlsm
0
csehz
Asked:
csehz
  • 4
  • 2
1 Solution
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You may try something like this......

Sub ReArrangeData()
Dim sws As Worksheet, dws As Worksheet
Set sws = Sheets("Sheet1")
Set dws = Sheets("Target")
dws.Cells.Clear
On Error Resume Next
sws.Columns("A:A").SpecialCells(xlCellTypeConstants, 1).Copy dws.Range("A1")
sws.Columns("A:A").SpecialCells(xlCellTypeConstants, 2).Copy dws.Range("B1")
dws.Activate
End Sub

Open in new window

0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
Try the suggested code on your sample workbook as the code assumes that there are two sheets called Target and Sheet1 in the workbook where Sheet1 contains the raw data. If the sheet names are different, please change them in the code as per the actual sheet names.
0
 
csehzIT consultantAuthor Commented:
Thank you it works of course,

could you please advise how to modify the code if the A1,A3,A5 etc cells are not number but also text?
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
In that case, try this.....
Sub ReArrangeDataV2()
Dim sws As Worksheet, dws As Worksheet
Dim lr As Long
Application.ScreenUpdating = False
Set sws = Sheets("Sheet1")
Set dws = Sheets("Target")
lr = sws.Cells(Rows.Count, 1).End(xlUp).Row
dws.Cells.Clear
sws.Columns(1).Insert
sws.Range("A1:A" & lr).Formula = "=IF(MOD(ROW(),2)=1,NA(),2)"
sws.Range("A:A").SpecialCells(xlCellTypeFormulas, 16).Offset(0, 1).Copy dws.Range("A1")
sws.Range("A:A").SpecialCells(xlCellTypeFormulas, 1).Offset(0, 1).Copy dws.Range("B1")
sws.Columns(1).Delete
dws.Activate
Application.ScreenUpdating = True
End Sub

Open in new window

0
 
csehzIT consultantAuthor Commented:
Thank you that is amazing, it works great
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome. Glad to help.
Thanks for the feedback.
0

Featured Post

Hire Technology Freelancers with Gigs

Work with freelancers specializing in everything from database administration to programming, who have proven themselves as experts in their field. Hire the best, collaborate easily, pay securely, and get projects done right.

  • 4
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now