---

Copy Multiple Column & Row Records Into Single Row Record

Got any Excel/VBA Questions? Free Excel Help

Copy Multiple Column & Row Records Into Single Row Records

The Multi Column & Row records must have blanks between each area.

Sub CopyAreasToRows()

Dim lRows As Long, lCol As Long, lColCount As Long

Dim rCol As Range, lPasteRow As Long
Dim lLoopCount As Long

Dim rRange As Range, rCell As Range
Dim wsStart As Worksheet, wsTrans As Worksheet


    Set rCol = Application.InputBox(Prompt:="Select columns", _
                           Title:="TRANSPOSE ROWS", Type:=8)

                                    

    'Cancelled or non valid range
    If rCol Is Nothing Then Exit Sub
    'Set Worksheet variables
    Set wsStart = ActiveSheet
    Set wsTrans = Sheets.Add()
    On Error Resume Next
    Application.ScreenUpdating = False

  lColCount = rCol.Columns.Count
  lPasteRow = 1
    Set rRange = rCol.Range(wsStart.Cells(1, 1), wsStart.Cells(wsStart.Rows.Count, 1).End(xlUp))
            For Each rCell In rRange
               If rCell <> "" Then
                  lLoopCount = rCell.Row
                        With wsStart
                            .Range(.Cells(lLoopCount, 1), .Cells(lLoopCount, lColCount)).Copy
                        End With
                        wsTrans.Cells(lPasteRow, wsTrans.Columns.Count).End(xlToLeft)(1, 2).PasteSpecial
                        Application.CutCopyMode = False
               Else
                   lPasteRow = lPasteRow + 1
               End If
            Next rCell
    With wsTrans
      .Columns.AutoFit
      .Columns(1).Delete
    End With
    On Error GoTo 0
    Application.ScreenUpdating = True


End Sub

 

See also:

Speed up Excel VBA Macro Code

Functions To Determine Excel Calculation Status & Mode

Change Text to Upper Case or Proper Case

Color or Format a Formula Referenced Cells - Precedents

 

Free Training Course: Lesson 1 - Excel Fundamentals

 

See also: Index to Excel VBA Code; Index to Excel Freebies; Lesson 1 - Excel Fundamentals; Index to how to… providing a range of solutions

 

Click here to visit our Free 24/7 Excel/VBA Help Forum where there are thousands of posts you can get information from, or you can join the Forum and post your own questions.

Gallery

---

• 
• 
• 
• 
• 
•