Solved: Autofill column with the values from next column ...etc

[white_flag]

Hello:

it is possible to do the following:
I have this table:
name1-name2-name3
1---------a------I
2---------b------II
3---------c------III
4---------d------IV
5---------e------
6---------f------
7---------
8---------
9---------


To become like this
name1---8---------e-----
1---------9---------f-----
2-------------------------
3---------name2 --name3
4---------a---------I
5---------b---------II
6---------c---------III
7---------d---------IV
or an idea how to do it.

thank you

[Bob Phillips]

What's the logic behind it?

[white_flag]

Good morning (here is raining pretty bad),

I have to fill entire A4 (paper, landscape) because in some columns are just 4 or 5 entry's. so like that can be print on just one A4 instead of A3. The data need to be see on a single page.

[Bob Phillips]

It's lovely over here, cold but sunny, you should come visit

Sorry, I worded my question badly. I didn't mean the logic as to what you are doing it for, I meant what is the logic that determines how that data gets transformed, I cannot see it just looking at the data. Without understanding the rules, it is difficult to come up with some code to achieve the desired results.

[white_flag]

too much stuff to do ... holiday, maybe next year.

so...
merge all columns and filled in a range?


[vba]
Option Explicit
Sub copy_table()

Dim wks As Worksheet, SheetName As String, SheetNameToCopy
Dim last_row_from_column
SheetName = "Data"
SheetNameToCopy = "Table"

Set wks = ThisWorkbook.Worksheets(SheetName)
Set last_row_from_column = wks.Cells(Rows.Count, first_col(SheetName)).End(xlUp)


wks.Range(last_row_from_column.Address, Cells(first_col(SheetName)).Address).Copy
Sheets(SheetNameToCopy).Range("A1:H100").PasteSpecial Paste:=xlPasteValues

End Sub
Function first_row(SheetName As String) As Long
Dim wks As Worksheet
Set wks = ThisWorkbook.Worksheets(SheetName)
first_row = wks.UsedRange.Row
End Function
Function first_col(SheetName As String) As Long
Dim wks As Worksheet
Set wks = ThisWorkbook.Worksheets(SheetName)
first_col = wks.UsedRange.Column
End Function
Function last_row(SheetName As String) As Long
Dim wks As Worksheet
Set wks = ThisWorkbook.Worksheets(SheetName)
last_row = wks.UsedRange.Rows(UBound(wks.UsedRange.Value)).Row
End Function
Function last_col(SheetName As String) As Long
Dim wks As Worksheet
Set wks = ThisWorkbook.Worksheets(SheetName)
last_col = wks.UsedRange.Columns(UBound(wks.UsedRange.Value, 2)).Column
End Function
[/vba]

[Bob Phillips]

Is that code your solution, it doesn't seem to do what you originally ask.

[white_flag]

no no ...sorry that was something else.

[VBA]
Sub MergeToColumn()
Dim r As Range, j As Integer
Worksheets("Data").Activate
For j = 1 To 30
With Columns(j)
If Cells(2, j).Value = 0 Then
Set r = Cells(1, j)
Else
Set r = Range(Cells(1, j), Cells(1, j).End(xlDown))
End If
r.Copy
With Worksheets("Table")
.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial
End With
End With
Next j
Application.CutCopyMode = False
End Sub
[/VBA]

this the merge of columns ...now I need to add an empty cell after the first column and to fitted inside of the range.

[Bob Phillips]

Does this work for you?

[VBA]Sub MergeToColumn()
Dim lastrow As Long
Dim numrows As Long

Worksheets("Table").UsedRange.ClearContents
Worksheets("Data").UsedRange.Copy Worksheets("Table").Range("A1")

With Worksheets("Table")

lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
numrows = .Cells(.Rows.Count, "B").End(xlUp).Row + 1
.Range("B1").Resize(lastrow - numrows + 1, .UsedRange.Columns.Count - 1).Insert shift:=xlDown
.Cells(numrows + 1, "A").Resize(lastrow - numrows, .UsedRange.Columns.Count).Copy .Range("B1")
.Cells(numrows + 1, "A").Resize(lastrow - numrows, .UsedRange.Columns.Count).ClearContents
End With
End Sub[/VBA]

[white_flag]

error '1004' - Application-defined ...
[VBA]
.Range("B1").Resize(lastrow - numrows + 1, .UsedRange.Columns.Count - 1).Insert shift:=xlDown
[/VBA]

[Bob Phillips]

Is that with the exact data you showed as that worked for me.

[white_flag]

checked, but in my case..it is not working (see attachment). That will be nice to know myself why it is not working? ..but I have no idea

[Bob Phillips]

This data is not the same as you originally showed. This is why I asked what was the rule to determine how to reformat the data, to take care of any setup. You just gave an example so I coded to the example, not knowing the rule.

I can see why it fails, but without knowing what the desired layout for this data set is, or better the full transformation rules, I don't know how to code it to achieve said desired layout.

[white_flag]

my English is not so brilliant (this is the reason)
so:
I have 10 columns. the code need to do:
put the values from (data) to (table). Will start with the first column from worksheet "Data". If the rows from the first column will be more then desired length (in worksheet "table") will start to fill the second column in worksheet "Table". when the column from "Data" doesn't have any values, code will let on cell space in "Table" and will start with the following column from "Data" to "Table" ..etc ..till the values from worksheet "Data" will be finished to be filled in workbook "Table". (will result a table without headers)

It will result a filed worksheet "table" with column putted "head by head"

this is clearer?

[white_flag]

so I put the code like this:

[vba]
Option Explicit
Sub copy_table()

Dim master As String, slave As String
Dim f_row As Integer, f_col, l_row, l_col, f_row_slave, f_col_slave, l_row_from_col, l_row_from_col_slave, i

master = "Data"
slave = "Table"

Worksheets(slave).UsedRange.ClearContents

f_row = Worksheets(master).UsedRange.Row
f_col = Worksheets(master).UsedRange.Column
l_row = Worksheets(master).UsedRange.Rows(UBound(Worksheets(master).UsedRange.Value )).Row
l_col = Worksheets(master).UsedRange.Columns(UBound(Worksheets(master).UsedRange.Va lue, 2)).Column

f_row_slave = Worksheets(slave).UsedRange.Row
f_col_slave = Worksheets(slave).UsedRange.Column

For i = 0 To l_col - f_col
l_row_from_col = Worksheets(master).Cells(Rows.Count, f_col + i).End(xlUp).Row
l_row_from_col_slave = Worksheets(slave).Cells(Rows.Count, f_col_slave).End(xlUp).Row
ThisWorkbook.Sheets(master).Range(Cells(1, f_col + i).Address, Cells(l_row_from_col, f_col + i).Address).Copy

If i = 0 Then
Sheets(slave).Range("A" & l_row_from_col_slave).PasteSpecial
Else
Sheets(slave).Range("A" & l_row_from_col_slave + 2).PasteSpecial
End If

Next
End Sub
[/vba]
but now, I do not know how to transpose column in columns (based on a split number that will give the width of the future table)

[white_flag]

the final code:

[VBA]

Sub copy_table()

Dim master As String, slave As String
Dim f_row As Integer, f_col, l_row, l_col, f_row_slave, f_col_slave, l_col_slave, l_row_from_col, l_row_from_col_slave, i
Dim rowss As Long, R As Long, X As Long, C As Long
Dim rng As Range

master = "Data"
slave = "Table"

Worksheets(slave).UsedRange.ClearContents

f_row = Worksheets(master).UsedRange.Row
f_col = Worksheets(master).UsedRange.Column
l_row = Worksheets(master).UsedRange.rows(UBound(Worksheets(master).UsedRange.Value )).Row
l_col = Worksheets(master).UsedRange.Columns(UBound(Worksheets(master).UsedRange.Va lue, 2)).Column

f_row_slave = Worksheets(slave).UsedRange.Row
f_col_slave = Worksheets(slave).UsedRange.Column

For i = 0 To l_col - f_col
l_row_from_col = Worksheets(master).Cells(rows.Count, f_col + i).End(xlUp).Row
l_row_from_col_slave = Worksheets(slave).Cells(rows.Count, f_col_slave).End(xlUp).Row
ThisWorkbook.Sheets(master).Range(Cells(1, f_col + i).Address, Cells(l_row_from_col, f_col + i).Address).Copy
If i = 0 Then
Sheets(slave).Range("A" & l_row_from_col_slave).PasteSpecial
Else
Sheets(slave).Range("A" & l_row_from_col_slave + 2).PasteSpecial
End If

Next
l_row_from_col_slave = Worksheets(slave).Cells(rows.Count, f_col_slave).End(xlUp).Row
l_col_slave = Worksheets(slave).UsedRange.Columns(UBound(Worksheets(slave).UsedRange.Valu e, 2)).Column
Set rng = Worksheets(slave).Range(Cells(f_row_slave, f_col_slave).Address, Cells(l_row_from_col_slave, l_col_slave).Address)
rowss = Application.InputBox("How many rows maximum do you want?", Title:="How many Rows?", Type:=1)
If rowss > 0 Then
Application.ScreenUpdating = False
For X = 0 To rng.rows.Count Step rowss
rng.Offset(X).Resize(rowss, l_col_slave).Copy Sheets(slave).Range("A1").Offset(, C)
C = C + l_col_slave
Next
Application.ScreenUpdating = True
End If
Worksheets(slave).Range(Cells(rowss + 1, f_col_slave).Address, Cells(l_row_from_col_slave, l_col_slave).Address).Delete
Worksheets(slave).Range("A1").Select
End Sub
[/VBA]