View Single Post
  #3   Report Post  
Posted to microsoft.public.excel.programming
GS[_6_] GS[_6_] is offline
external usenet poster
 
Posts: 1,182
Default Copy data from multiple sheets to new workbook


Loop through each cell from F12 to last blank cell which is a list of
descriptions (Note that column N has Formulas) and paste to new workbook
Column B.


Do you mean "from F12 to last NON-blank cell"?

Then copy first name from N10 and paste to Col A and drag down to list of
descriptions copy from Column F.


Not sure what you mean by this. Why N10, not N12?

Then loop through the remainder of Row 10 for each name until cell text like
Name and copy the data from row 12 down.


Also not sure what you mean by this.


Here is an example. Put this into a code module of your current workbook.
The new workbook will be created automatically. I put some comments to let
you know what each line is doing.

Note you can either copy values (faster) or do an actual Range.Copy (carrying
over cell formats, formulae, etc). I went with the former, but wrote it both
ways for you to decide.

Note also that this is untested, so post back if you get errors.


Public Sub LoopSheets()
Dim wsh As Excel.Worksheet

Dim wkbNew As Excel.Workbook
Dim wshNew As Excel.Worksheet

Dim rngFrom As Excel.Range
Dim rngTo As Excel.Range

' create a new workbook
Set wkbNew = Application.Workbooks.Add
Set wshNew = wkbNew.Worksheets(1)

' loop through sheets
For Each wsh In ThisWorkbook.Worksheets
' each sheet with name like "dept" and N10 not like "name"
If LCase(wsh.Name) Like "*dept*" And Not LCase(wsh.Range("N10").Value)
Like "*name*" Then

' set the from range you are copying in current sheet
Set rngFrom = Range(wsh.Range("F12"), wsh.Range("F12").End(xlDown))
' find the first blank cell in column B in the new worksheet
Set rngTo = wshNew.Range("B" & wshNew.Rows.Count).End(xlUp).Offset(1,
0)

' to copy to the new workbook
rngTo.Resize(rngFrom.Rows.Count, rngFrom.Columns.Count).Value =
rngFrom.Value ' or
' rngFrom.Copy rngTo

' move from column F to column N, 8 columns offset
Set rngFrom = rngFrom.Offset(0, 8)
' move from column B to column C, -1 columns offset
Set rngTo = rngTo.Offset(0, 1)

' to copy to the new
rngTo.Resize(rngFrom.Rows.Count, rngFrom.Columns.Count).Value =
rngFrom.Value ' or
' rngFrom.Copy rngTo
End If
' loop through the remaining sheets
Next wsh

End Sub


Very nice!

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion