L
L. Howard
The second InputBox is to get the column letter of the last column to include in the code as the range to transfer a long column/s into several shorter column/s to the next sheet.
I want to be able to change nCols in this line to the column of my choice.
wks1.Range("A" & i & ":nCols" & i + nnCols).Copy wks2.Cells(1, j)...
I can hard code it to C, D or whatever and it works fine.
Thanks.
Howard
Option Explicit
Sub AcolumToNcolumns()
Dim wks1 As Worksheet, wks2 As Worksheet
Dim iColumn As Integer
Dim lLast As Long
Dim i As Long, j As Integer, y As Integer
Dim nRows As String
Dim nnCols As String
Dim nCols As String
nRows = InputBox("Colum No. of Rows.", "Enter value")
If nRows = vbNullString Then Exit Sub
nCols = InputBox("Colum A to Column ?", "Enter Column Letter")
If nCols = vbNullString Then Exit Sub
nnCols = nRows - 1
Set wks1 = Worksheets("One Column")
Set wks2 = Worksheets("N Columns")
lLast = wks1.Cells(wks1.Rows.Count, 1).End(xlUp).Row
j = wks2.Cells(1, wks2.Columns.Count).End(xlToLeft).Column
For iColumn = 1 To nRows
lLast = Application.Max(lLast, wks1.Cells(wks1.Rows.Count, _
iColumn).End(xlUp).Row)
Next iColumn
If lLast < nRows Then
MsgBox "Less than nnCols rows", vbOKOnly
Exit Sub
End If
For i = 1 To lLast Step nRows
wks1.Range("A" & i & ":nCols" & i + nnCols).Copy wks2.Cells(1, j)
j = wks2.Cells(1, wks2.Columns.Count).End(xlToLeft).Column + 1
' To cut data to sheet 2
'wks1.Range("A" & i & ":nCols" & i + nnCols).Cut wks2.Cells(1, j)
'j = wks2.Cells(1, wks2.Columns.Count).End(xlToLeft).Column + 1
Next
wks2.Activate
Columns("A:Z").HorizontalAlignment = xlCenter
Application.Columns("A:Z").AutoFit
wks1.Activate
Set wks1 = Nothing
Set wks2 = Nothing
End Sub
I want to be able to change nCols in this line to the column of my choice.
wks1.Range("A" & i & ":nCols" & i + nnCols).Copy wks2.Cells(1, j)...
I can hard code it to C, D or whatever and it works fine.
Thanks.
Howard
Option Explicit
Sub AcolumToNcolumns()
Dim wks1 As Worksheet, wks2 As Worksheet
Dim iColumn As Integer
Dim lLast As Long
Dim i As Long, j As Integer, y As Integer
Dim nRows As String
Dim nnCols As String
Dim nCols As String
nRows = InputBox("Colum No. of Rows.", "Enter value")
If nRows = vbNullString Then Exit Sub
nCols = InputBox("Colum A to Column ?", "Enter Column Letter")
If nCols = vbNullString Then Exit Sub
nnCols = nRows - 1
Set wks1 = Worksheets("One Column")
Set wks2 = Worksheets("N Columns")
lLast = wks1.Cells(wks1.Rows.Count, 1).End(xlUp).Row
j = wks2.Cells(1, wks2.Columns.Count).End(xlToLeft).Column
For iColumn = 1 To nRows
lLast = Application.Max(lLast, wks1.Cells(wks1.Rows.Count, _
iColumn).End(xlUp).Row)
Next iColumn
If lLast < nRows Then
MsgBox "Less than nnCols rows", vbOKOnly
Exit Sub
End If
For i = 1 To lLast Step nRows
wks1.Range("A" & i & ":nCols" & i + nnCols).Copy wks2.Cells(1, j)
j = wks2.Cells(1, wks2.Columns.Count).End(xlToLeft).Column + 1
' To cut data to sheet 2
'wks1.Range("A" & i & ":nCols" & i + nnCols).Cut wks2.Cells(1, j)
'j = wks2.Cells(1, wks2.Columns.Count).End(xlToLeft).Column + 1
Next
wks2.Activate
Columns("A:Z").HorizontalAlignment = xlCenter
Application.Columns("A:Z").AutoFit
wks1.Activate
Set wks1 = Nothing
Set wks2 = Nothing
End Sub