I have an Excel sheet which consists of multiple columns. In each column there are multiple rows - not always the same number of rows, but never more then from row 8 to row 208. I need all values from each column in a new column as one ordered list, beginning with column 3 (being C) till column 23 (being Z). I need this new column (being at position AB in the same sheet) with ALL values and without empty rows, as it is the source for a drop down list.
This is, what I have so far but it does not work:
Sub createDDICListe()
Dim c
Dim counter
Dim cnt
Dim Start
Dim Ende
Start = 8
Ende = 208
counter = 8
cnt = Start
Set Spalten = ["C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", "Y"]
ActiveSheet.Range("AB7") = "DDIC-Liste:"
For Each c In Spalten
cnt = Start
On Error Resume Next
For cnt = Start To cnt <= Ende
Dim Cell
Cell = Cells(cnt, c)
If IsError(Cell) Or Cell.Value = False Or Cell.Value = "" Then
GoTo weiter
Else
Cells(counter, "AB").Value = Cell.Value
counter = counter + 1
End If
cnt = cnt + 1
Next
weiter:
Next
End Sub
How to iterate over the columns and in this "for each loop" iterate over the rows and copy the cell-value in the new column row by row?
Should do the job very quickly:
Sub MacroMan()
Dim x, y
x = [C8:Z208]
Range("AB7").Value = "DDIC-Liste:"
For Each y In x
If Not y = vbNullString Then Range("AB" & Rows.count).End(xlUp).Offset(1, 0).value = y
Next
End Sub
This should do the job:
Dim pasteCell As Range, origin As Range
Set pasteCell = [AB1] 'Destination
Dim firstRow as Long
firstRow = 1
For columnIndex = 3 To 26 Step 1 'Columns from C to Z
Set origin = Range(Cells(firstRow , columnIndex), Cells(firstRow , columnIndex).End(xlDown))
origin.Copy
pasteCell.Insert xlShiftDown, origin
Next columnIndex
Set origin = Nothing
You can adapt the Destination cell and of course the first copied row of each column.
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.