Row dates into one column
Closed
alish
-
Jul 23, 2010 at 02:28 AM
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - Jul 24, 2010 at 05:16 AM
rizvisa1 Posts 4478 Registration date Thursday January 28, 2010 Status Contributor Last seen May 5, 2022 - Jul 24, 2010 at 05:16 AM
Related:
- Row dates into one column
- Saints row 2 cheats - Guide
- Display two columns in data validation list but return only one - Guide
- How to delete a row in a table in word - Guide
- Saints row free download - Download - Action and adventure
- How do i auto number a column in excel? ✓ - Excel Forum
1 response
rizvisa1
Posts
4478
Registration date
Thursday January 28, 2010
Status
Contributor
Last seen
May 5, 2022
766
Jul 24, 2010 at 05:16 AM
Jul 24, 2010 at 05:16 AM
try this
Sub MoveRowsBlockToColumns2() Dim sProcessSheet As String Dim lStartAtRow As Long Dim iColumnsBlockSize Dim iPivotColumn As Integer Dim lMaxRows As Long Dim lThisRow As Long Dim iMaxCol As Integer ' Dim sActiveSheet As String ' Dim bScreenUpdating As Boolean ' sProcessSheet = "Sheet9" iColumnsBlockSize = 1 lStartAtRow = 2 iPivotColumn = 2 bScreenUpdating = Application.ScreenUpdating sActiveSheet = ActiveSheet.Name On Error GoTo ERROR_HANDLER Sheets(sProcessSheet).Select Columns(2).Insert lMaxRows = Cells.Find("*", Cells(1, 1), SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row lThisRow = lStartAtRow 'start from this row Do While lThisRow <= lMaxRows iMaxCol = Cells(lThisRow, Columns.Count).End(xlToLeft).Column If (iMaxCol > iColumnsBlockSize + iPivotColumn) Then Rows(lThisRow + 1 & ":" & lThisRow + iMaxCol - iPivotColumn - iColumnsBlockSize).Insert Range(Cells(lThisRow, iColumnsBlockSize + iPivotColumn + 1), Cells(lThisRow, iMaxCol)).Copy Cells(lThisRow + 1, iPivotColumn + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True Range(Cells(lThisRow, iColumnsBlockSize + iPivotColumn + 1), Cells(lThisRow, iMaxCol)).Clear Range(Cells(1, iColumnsBlockSize + iPivotColumn + 1), Cells(1, iMaxCol)).Copy Cells(lThisRow + 1, iPivotColumn).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True Cells(lThisRow, 1).Copy Range(Cells(lThisRow + 1, 1), Cells(lThisRow + iMaxCol - iPivotColumn - iColumnsBlockSize, 1)).PasteSpecial End If Cells(1, iColumnsBlockSize + iPivotColumn).Copy Cells(lThisRow, iPivotColumn).PasteSpecial If (iMaxCol > iColumnsBlockSize + iPivotColumn) Then lThisRow = lThisRow + iMaxCol - iPivotColumn - iColumnsBlockSize lMaxRows = lMaxRows + iMaxCol - iPivotColumn - iColumnsBlockSize End If lThisRow = lThisRow + 1 Loop Range(Cells(1, iColumnsBlockSize + iPivotColumn), Cells(1, iMaxCol)).ClearContents Cells(1, 2) = "Date" Cells(1, 3) = "Hours" End_Sub: Sheets(sActiveSheet).Select Application.ScreenUpdating = bScreenUpdating Exit Sub ERROR_HANDLER: MsgBox Err.Description GoTo End_Sub End Sub