chzhd4life
New Member
- Joined
- Jan 6, 2020
- Messages
- 13
- Office Version
- 365
- Platform
- Windows
Help, have multiple very long "tables" of data in a single column. Need to transpose/convert to standard table format. Entries are divided by blank row or rows. Not all entries have same pieces of data, e.g., some have Name, Address, City/ST/Zip, Phone, email, website URL, etc. Others may be missing some pieces of information. Found a macro (below) that described my same scenario but it's not working (run-time error 1004) and when I debug it appears to be getting hung up at "Cells(strt, 1).Resize(nd - strt).Copy". Help?
Sub Paste_Transpose()
Dim LastRow As Long, x As Long
Dim PasteRow As Long
Dim strt As Long, nd As Long
LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
PasteRow = 1
For x = 1 To LastRow + 1
If Len(Cells(x, 1)) = 0 And strt = 0 And nd = 0 Then
strt = Cells(x, 1).Row + 1
Else
If strt > 0 And Len(Cells(x, 1)) = 0 Then
nd = Cells(x, 1).Row
'paste transpose
Cells(strt, 1).Resize(nd - strt).Copy
Cells(PasteRow, 2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
strt = 0
nd = 0
x = x - 1
PasteRow = PasteRow + 1
End If
End If
Next
Application.CutCopyMode = False
'Columns(1).Delete
End Sub
Sub Paste_Transpose()
Dim LastRow As Long, x As Long
Dim PasteRow As Long
Dim strt As Long, nd As Long
LastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
PasteRow = 1
For x = 1 To LastRow + 1
If Len(Cells(x, 1)) = 0 And strt = 0 And nd = 0 Then
strt = Cells(x, 1).Row + 1
Else
If strt > 0 And Len(Cells(x, 1)) = 0 Then
nd = Cells(x, 1).Row
'paste transpose
Cells(strt, 1).Resize(nd - strt).Copy
Cells(PasteRow, 2).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
strt = 0
nd = 0
x = x - 1
PasteRow = PasteRow + 1
End If
End If
Next
Application.CutCopyMode = False
'Columns(1).Delete
End Sub