|
Sub ReFormat()
'
' Reformat from a row to columns
'
Dim iStartRow As Integer, iSections As Integer, iCounter As Integer
Dim bEndMe As Boolean
Dim sRange As String
bEndMe = False
iStartRow = 3 'The row that will initially be inserted. The row above this will be treated as master.
iSections = 8 'How many sections of rows will be copied
Do
Call ReformatActions(iStartRow, iSections)
sRange = "A" & CStr(iStartRow)
If Range(sRange).Value = "" Then bEndMe = True
iStartRow = iStartRow + iSections
Loop Until bEndMe = True
'Call DeleteEmptyRows 'Delete empty rows macro supplied in the free macro list
'Now just tidy up the worksheet. Fix headings and delete data that has been copied already.
Range("Y1:CW1").Select
Selection.Delete Shift:=xlToLeft
Columns("AM:DQ").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Range("A1").Activate
End Sub
Sub ReformatActions(iStartRow As Integer, iSections As Integer)
'This macro converts 1 row with 8 sections in to 8 rows
'Used in conjunction with the DeleteEmptyRows macro, the sections that have no data can be removed.
'This is simple a 'get the job done' macro, not the best produced but will hopefully provide some handy tricks for newcomers
'
'To make this a bit smarter, try removing the sections and making them a funtion/sub that you can call.
'You will cut down on code and allow this to be more variable in how many sections there are in your row of data.
'Note there is another small section that is duplicated for each new row
'Another note is that the empty colums are not deleted. This was done manually out of .....laziness
'
Dim sString As String, sRange As String
sString = CStr(iStartRow) & ":" & CStr(iStartRow + iSections - 2)
sRange = "A" & CStr(iStartRow)
Rows(sString).Select
Selection.Insert Shift:=xlDown
Range(sRange).Select
' Copy the standard text to each line
sRange = "A" & CStr(iStartRow - 1) & ":M" & CStr(iStartRow - 1)
Range(sRange).Select
Selection.Copy
sRange = "A" & CStr(iStartRow) & ":M" & CStr(iStartRow + iSections - 2)
Range(sRange).Select
ActiveSheet.Paste
' Now copy each of the sections
'Section 2 (1 is not copied - its left where it is)
sRange = "Y" & CStr(iStartRow - 1) & ":AI" & CStr(iStartRow - 1)
Range(sRange).Select
Application.CutCopyMode = False
Selection.Cut
sRange = "N" & CStr(iStartRow)
Range(sRange).Select
ActiveSheet.Paste
'Section 3
sRange = "AJ" & CStr(iStartRow - 1) & ":AT" & CStr(iStartRow - 1)
Range(sRange).Select
Application.CutCopyMode = False
Selection.Cut
sRange = "N" & CStr(iStartRow + 1)
Range(sRange).Select
ActiveSheet.Paste
'Section 4
sRange = "AU" & CStr(iStartRow - 1) & ":BE" & CStr(iStartRow - 1)
Range(sRange).Select
Application.CutCopyMode = False
Selection.Cut
sRange = "N" & CStr(iStartRow + 2)
Range(sRange).Select
ActiveSheet.Paste
'Section 5
sRange = "BF" & CStr(iStartRow - 1) & ":BP" & CStr(iStartRow - 1)
Range(sRange).Select
Application.CutCopyMode = False
Selection.Cut
sRange = "N" & CStr(iStartRow + 3)
Range(sRange).Select
ActiveSheet.Paste
'Section 6
sRange = "BQ" & CStr(iStartRow - 1) & ":CA" & CStr(iStartRow - 1)
Range(sRange).Select
Application.CutCopyMode = False
Selection.Cut
sRange = "N" & CStr(iStartRow + 4)
Range(sRange).Select
ActiveSheet.Paste
'Section 7
sRange = "CB" & CStr(iStartRow - 1) & ":CL" & CStr(iStartRow - 1)
Range(sRange).Select
Application.CutCopyMode = False
Selection.Cut
sRange = "N" & CStr(iStartRow + 5)
Range(sRange).Select
ActiveSheet.Paste
'Section 8
sRange = "CM" & CStr(iStartRow - 1) & ":CW" & CStr(iStartRow - 1)
Range(sRange).Select
Application.CutCopyMode = False
Selection.Cut
sRange = "N" & CStr(iStartRow + 6)
Range(sRange).Select
ActiveSheet.Paste
' Now copy the last columns to each line
sRange = "CX" & CStr(iStartRow - 1) & ":DK" & CStr(iStartRow - 1)
Range(sRange).Select
Selection.Copy
sRange = "Y" & CStr(iStartRow - 1) & ":AL" & CStr(iStartRow + iSections - 2)
Range(sRange).Select
ActiveSheet.Paste
End Sub
|
