Solved: column loop

[vzachin]

hi,

i have a sheet named TEST that lists the sheets that i need to copy data from. For each sheet that appears in TEST, i need to copy column B5 into another sheet named DATA into the corresponding column name. i'm trying to consolidate all the column B5s into one sheet named DATA.
i can copy & paste the 1st sheet without any problems but i don't know how to paste into the next columns.
how do i loop and paste into the columns?


Sub test()
Dim ShName As String
Range("G14:G35").Select
Selection.Copy
Sheets("DATA").Select
Range("A4").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True

With Sheets("Test")
iLastRow = Sheets("test").Cells(Rows.Count, "G").End(xlUp).Row
For i = 14 To iLastRow
ShName = Sheets("test").Range("G" & i)
With Sheets(ShName)
.Range("B5", .Cells(.Rows.Count, "B").End(xlUp)).Copy Sheets("DATA").Range("A5")
End With
Next
End With
End Sub


thanks
zach

[Oorang]

Sub Test2()
Dim wb As Excel.Workbook
Dim wsInput As Excel.Worksheet
Dim wsOtput As Excel.Worksheet
Dim rngWrkshtList As Excel.Range
Dim rngWrkshtCell As Excel.Range
Dim ws As Excel.Worksheet
Dim lngClmn As Long
Set wb = Excel.ThisWorkbook
Set wsInput = wb.Worksheets("TEST")
Set rngWrkshtList = wsInput.Range("G14:G35")
'Eliminate empty cells:
Set rngWrkshtList = Excel.Intersect(rngWrkshtList, wsInput.UsedRange)
Set wsOtput = wb.Worksheets("DATA")
For Each rngWrkshtCell In rngWrkshtList.Cells
lngClmn = lngClmn + 1
wb.Worksheets(rngWrkshtCell.Value).Range("B5:B26").Copy wsOtput.Cells(5, lngClmn)
Next
End Sub

[vzachin]

Hi Aaron,

thanks for the coding.
one question: how do i replace Range("B5:B26") to Range("B5":last row) ?
my data in column B will vary

thanks again
zach

[Bob Phillips]

Set rng = Range(Range("B5"), Range("B5").End(xlDown))

[vzachin]

hi xld,


For Each rngWrkshtCell In rngWrkshtList.Cells
lngClmn = lngClmn + 1
wb.Worksheets(rngWrkshtCell.Value).Range("B5:B26").Copy wsOtput.Cells(5, lngClmn)
Next


i'm totally confused :dunno as to where to insert this
Set rng = Range(Range("B5"), Range("B5").End(xlDown))

i tried something like this but this didn't work
wb.Worksheets(rngWrkshtCell.Value).Range(Range("B5"), Range("B5").End(xlDown)) .Copy wsOtput.Cells(5, lngClmn)
would you please elaborate

thanks again
zach

[Simon Lloyd]

replace Range(Range("B5"), Range("B5").End(xlDown)) for.Range("B5:B" & Range("B" & Rows.Count).End(xlup).row)

[david000]

I failed at getting Oorangs code to adjust to a variable range too:think:
This would work but I don't have the answer right in front of me to read the sheet names into this style of sheet copying :dunno
Sub FruitLoops()
Dim c, i As Integer
Sheet3.Select
c = 0

For i = 2 To 8 '"Apples to Eggs"
Sheets(i).Select
GoSub DoCopy
GoSub DoPaste

Next i

Exit Sub

DoCopy:
Range(Cells(5, 2), Cells(Rows.Count, 2).End(xlUp)).Copy
Return

DoPaste:
Sheet3.Select
Cells(5, 1).Offset(, c).Select
ActiveSheet.Paste
c = c + 1
Return
End Sub

[vzachin]

hi Simon

.Range("B5:B" & Range("B" & Rows.Count).End(xlup).row)
the Rows.Count seems to look at the active sheet row count and not wb.Worksheets(rngWrkshtCell.Value).Range("B5:B26").Copy wsOtput.Cells(5, lngClmn)
this works
wb.Worksheets(rngWrkshtCell.Value).Range("B5:B65536").Copy wsOtput.Cells(5, lngClmn) so i shouldn't even complain

david000's code works for me

thanks
zach

[vzachin]

hi David000,

thanks for the fruit loops and it tastes GREAT!:thumb
here's the modified code

Sub FruitLoops()
Dim ShName As String
Dim c, i As Integer
Sheets("Data").Select
c = 0

With Sheets("Test")
iLastRow = Sheets("test").Cells(Rows.Count, "G").End(xlUp).Row
For i = 14 To iLastRow
ShName = Sheets("test").Range("G" & i)
Sheets(ShName).Select
GoSub DoCopy
GoSub DoPaste

Next i

End With
Exit Sub

DoCopy:
Range(Cells(5, 2), Cells(Rows.Count, 2).End(xlUp)).Copy
Return

DoPaste:
Sheets("Data").Select
Cells(5, 1).Offset(, c).Select
ActiveSheet.Paste
c = c + 1
Return
End Sub




thanks again
zach

[Simon Lloyd]

It looks at the active sheet because i missed a qualifier:

this should
.Range("B5:B" & Range("B" & Rows.Count).End(xlup).row)
look like.Range("B5:B" & .Range("B" & Rows.Count).End(xlup).row)