![]() |
For Each loop
I have a workbook with multiple worksheets. My "MAIN" sheet has Names
in column A, and Sales data in Columns B and C. The other worksheets are titled after column A. I want to cycle through the names on my MAIN sheet and copy the data to the worksheet matching the name in column A. Please help me with this For Each loop. *** Sent via Developersdex http://www.developersdex.com *** |
For Each loop
Michael,
Copies data to columns A & B on named worksheets. Change wks2.Range("a" & nr) to wks2.Range("b" & nr) if B required. HTH Sub CopyToSheets() Dim lastrow As Long Dim ws1 As Worksheet, ws2 As Worksheet Dim Wks Set ws1 = ThisWorkbook.Worksheets("MAIN") ws1.Activate With ws1 lastrow = .Cells(Rows.Count, "A").End(xlUp).Row For r = 2 To lastrow Set wks2 = Worksheets(Cells(r, 1).Value) nr = wks2.Cells(Rows.Count, 1).End(xlUp).Row + 1 ws1.Cells(r, 1).Offset(0, 1).Resize(1, 2).Copy wks2.Range("a" & nr) Next r End With End Sub "Michael Smith" wrote: I have a workbook with multiple worksheets. My "MAIN" sheet has Names in column A, and Sales data in Columns B and C. The other worksheets are titled after column A. I want to cycle through the names on my MAIN sheet and copy the data to the worksheet matching the name in column A. Please help me with this For Each loop. *** Sent via Developersdex http://www.developersdex.com *** |
For Each loop
Thank you, thank you!..that works wonderfully....one last question that
I probably should have included in the original post, if the worksheet(Name in column A) doesn't exist, how would i get it to create a new worksheet with that name. Thanks again, i was on the wrong track before your help. -Mike *** Sent via Developersdex http://www.developersdex.com *** |
For Each loop
Debra Dalgleish and Ron de Bruin have samples that you may like. Ron's addin
may be sufficient right out of the box. Debra's site: http://www.contextures.com/excelfiles.html Create New Sheets from Filtered List -- uses an Advanced Filter to create separate sheet of orders for each sales rep visible in a filtered list; macro automates the filter. AdvFilterRepFiltered.xls 35 kb or Update Sheets from Master -- uses an Advanced Filter to send data from Master sheet to individual worksheets -- replaces old data with current. AdvFilterCity.xls 55 kb And Ron de Bruin's easyfilter. http://www.rondebruin.nl/easyfilter.htm Michael Smith wrote: I have a workbook with multiple worksheets. My "MAIN" sheet has Names in column A, and Sales data in Columns B and C. The other worksheets are titled after column A. I want to cycle through the names on my MAIN sheet and copy the data to the worksheet matching the name in column A. Please help me with this For Each loop. *** Sent via Developersdex http://www.developersdex.com *** -- Dave Peterson |
For Each loop
Michael,
Try this. Function routine is courtesy of Bob Phillips from a previous posting. Sub CopyToSheets() Dim lastrow As Long Dim ws1 As Worksheet, ws2 As Worksheet Dim Wks Set ws1 = ThisWorkbook.Worksheets("MAIN") ws1.Activate With ws1 lastrow = .Cells(Rows.Count, "A").End(xlUp).Row For r = 2 To lastrow If Not SheetExists(.Cells(r, 1)) Then Set NewWS = Worksheets.Add NewWS.Name = .Cells(r, 1) End If Set wks2 = Worksheets(.Cells(r, 1).Value) nr = wks2.Cells(Rows.Count, 1).End(xlUp).Row + 1 ws1.Cells(r, 1).Offset(0, 1).Resize(1, 2).Copy wks2.Range("a" & nr) Next r End With End Sub '----------------------------------------------------------------- Function SheetExists(Sh As String, _ Optional wb As Workbook) As Boolean '----------------------------------------------------------------- Dim oWs As Worksheet If wb Is Nothing Then Set wb = ActiveWorkbook On Error Resume Next SheetExists = CBool(Not wb.Worksheets(Sh) Is Nothing) On Error GoTo 0 End Function "Michael Smith" wrote: Thank you, thank you!..that works wonderfully....one last question that I probably should have included in the original post, if the worksheet(Name in column A) doesn't exist, how would i get it to create a new worksheet with that name. Thanks again, i was on the wrong track before your help. -Mike *** Sent via Developersdex http://www.developersdex.com *** |
All times are GMT +1. The time now is 11:56 PM. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
ExcelBanter.com