PDA

View Full Version : Solved: column loop



vzachin
05-09-2008, 07:34 PM
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
05-09-2008, 11:11 PM
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
05-10-2008, 06:02 PM
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
05-11-2008, 02:39 AM
Set rng = Range(Range("B5"), Range("B5").End(xlDown))

vzachin
05-11-2008, 01:34 PM
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
05-11-2008, 01:42 PM
replace Range(Range("B5"), Range("B5").End(xlDown)) for.Range("B5:B" & Range("B" & Rows.Count).End(xlup).row)

david000
05-11-2008, 07:29 PM
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
05-12-2008, 04:18 AM
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
05-12-2008, 04:25 AM
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
05-12-2008, 08:32 AM
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)