Global insertline As Long
Sub kb_date_split()
'
' kb_date_split Macro
'
'
Application.ScreenUpdating = False
Sheets("Output2").Select
Cells.Select
Selection.ClearContents
Sheets("Output").Select
Cells.Select
Selection.ClearContents
Sheets("SingleAnalysisComputerListRepor").Select
Range("A10").Select
Selection.End(xlDown).Select
lastrow = Selection.Row
insertline = 1
For doserver = 10 To lastrow
Sheets("Output").Select
Cells.Select
Selection.ClearContents
Sheets("SingleAnalysisComputerListRepor").Select
Columns("A:A").ColumnWidth = 14.82
Range("A" & doserver).Select
Selection.Copy
Sheets("Output").Select
Range("A1").Select
ActiveSheet.Paste
Columns("A:A").ColumnWidth = 8
Columns("A:A").EntireColumn.AutoFit
Sheets("SingleAnalysisComputerListRepor").Select
Range("B" & doserver).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Output").Select
Range("B1").Select
ActiveSheet.Paste
Sheets("SingleAnalysisComputerListRepor").Select
Range("C" & doserver).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Output").Select
Range("B2").Select
ActiveSheet.Paste
Range("A1").Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("A1:A2")
Range("B1:B2").Select
Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=False, _
Semicolon:=True, Comma:=False, Space:=True, Other:=True, OtherChar:= _
""""
Call transpose
Next doserver
End Sub
Sub transpose()
'
' test Macro
'
'
Sheets("Output").Select
Range("A1").Select
Selection.Copy
Sheets("Output2").Select
Range("A" & insertline).Select
ActiveSheet.Paste
Sheets("Output").Select
Range("B1:B2").Select
Range(Selection, Selection.End(xlToRight)).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Output2").Select
Range("B" & insertline).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, transpose:=True
Range("B" & insertline).Select
Selection.End(xlDown).Select
lastinsertrow = Selection.Row
Range("A" & insertline).Select
Application.CutCopyMode = False
Selection.AutoFill Destination:=Range("A" & insertline & ":A" & lastinsertrow), Type:=xlFillCopy
insertline = lastinsertrow + 1
End Sub
2 Likes