Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
VB Macro - Cppy rows of one sheet into mutiple sheets based on column value
I found this macro and modified it a bit. It does a great job copin rows from a "main" sheet into multiple sheets based off a column value I am struggling now to go to a deeper level were it will copy the ro based on one column value looking at all sheets in a workbook. S instead of it looking a at column value, creating a sheet if that valu does not exist then copying the mathing column data to that sheet. want to compare and look at the same column of all sheets in m workbook (column B in my case) and copy the row of matching data fro my "main" sheet (column B). So I want all my rows that have "excel.exe" in my "main" sheet to go t my "MS Excel" named sheet and all my "winprog.exe" rows to go my "M Project" named sheet and etc. Any assistance would be appreciated! Thanks Wesley Sub CopyRowsToSheets() 'copy rows to worksheets based on value in column A 'assume the worksheet name to paste to is the value in Col A Dim CurrentCell As Range Dim SourceRow As Range Dim Targetsht As Worksheet Dim TargetRow As Long Dim CurrentCellValue As String 'start with cell A2 on "Master" sheet Set CurrentCell = Worksheets("Master").Cells(2, 1) 'row ... column ... Do While Not IsEmpty(CurrentCell) CurrentCellValue = CurrentCell.Value Set SourceRow = CurrentCell.EntireRow 'Check if worksheet exists On Error Resume Next Testwksht = Worksheets(CurrentCellValue).Name If Err.Number = 0 Then 'MsgBox CurrentCellValue & " worksheet Exists" Else MsgBox "Adding a new worksheet for " & CurrentCellValue Worksheets.Add.Name = CurrentCellValue End If On Error GoTo 0 'reset on error to trap errors again Set Targetsht = ActiveWorkbook.Worksheets(CurrentCellValue) ' Find next blank row in Targetsht - check using Column A TargetRow = Targetsht.Cells(Rows.Count, 1).End(xlUp).Row + 1 SourceRow.Copy Destination:=Targetsht.Cells(TargetRow, 1) 'do the next cell Set CurrentCell = CurrentCell.Offset(1, 0) Loop End Su -- wester6 ----------------------------------------------------------------------- wester69's Profile: http://www.officehelp.in/member.php?userid=468 View this thread: http://www.officehelp.in/showthread.php?t=123334 Posted from - http://www.officehelp.i |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
VB Macro - Marking specific text in a column
I figured out my mistake, "UCase" was killing me. Here is the workin macro. -Wesley Sub Mark_zOpen() Dim lastrow As Long, r As Long lastrow = ActiveSheet.UsedRange.Rows.Count For r = lastrow To 1 Step -1 'Look for empty cell and put "zOpen" in empty cell If Cells(r, 1).Value = "" Then Cells(r, 1).Value = "zOpen" 'Look for zOpen value and mark it blue If Cells(r, 1).Value = "zOpen" Then Cells(r, 1).Font.Color = RGB(0 0, 255) Next r MsgBox "Empty & 'Open' slots have been marked." End Su -- wester6 ----------------------------------------------------------------------- wester69's Profile: http://www.officehelp.in/member.php?userid=468 View this thread: http://www.officehelp.in/showthread.php?t=123334 Posted from - http://www.officehelp.i |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Counting number of rows based on mutiple criteria | Excel Worksheet Functions | |||
Copy rows of one sheet into mutiple sheets based on column value | Excel Discussion (Misc queries) | |||
MACRO - copy rows based on value in column to another sheet | Excel Discussion (Misc queries) | |||
MACRO - copy rows based on value in column to another sheet | Excel Programming | |||
Cut rows from one sheet into multiple sheets based on a criteria in first column | Excel Programming |