Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change target sheet destination from A2 to M2.
Code works fine, just need minor adjustment to paste to M2 instead of
A2. Sub Cop_RowS_To_Sheets_TA() '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 A1 on Sheet1 Set CurrentCell = Worksheets("all corrects").Cells(1, 2) 'row 1 column 1 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 'TO INSERT SHEETS BEFORE A SPECIFIED SHEET, CHANGE NAME BELOW (END) Worksheets.Add(befo=Sheets("TA_END")).Name = CurrentCellValue End If On Error GoTo 0 'reset on error to trap errors again Set Targetsht = ActiveWorkbook.Worksheets(CurrentCellValue) 'note: using CurrentCell.value gave me an error if the value was numeric ' 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 Sub |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change target sheet destination from A2 to M2.
The last 1 in this line:
SourceRow.Copy Destination:=Targetsht.Cells(TargetRow, 1) is the column number. 1=A, 2=B, ... So maybe... SourceRow.Copy Destination:=Targetsht.Cells(TargetRow, 13) Even nicer is that .cells() will accept either a number or a letter (if it's valid). So you could use: SourceRow.Copy Destination:=Targetsht.Cells(TargetRow, "M") "J.W. Aldridge" wrote: Code works fine, just need minor adjustment to paste to M2 instead of A2. Sub Cop_RowS_To_Sheets_TA() '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 A1 on Sheet1 Set CurrentCell = Worksheets("all corrects").Cells(1, 2) 'row 1 column 1 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 'TO INSERT SHEETS BEFORE A SPECIFIED SHEET, CHANGE NAME BELOW (END) Worksheets.Add(befo=Sheets("TA_END")).Name = CurrentCellValue End If On Error GoTo 0 'reset on error to trap errors again Set Targetsht = ActiveWorkbook.Worksheets(CurrentCellValue) 'note: using CurrentCell.value gave me an error if the value was numeric ' 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 Sub -- Dave Peterson |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change target sheet destination from A2 to M2.
Change this section...
'start with cell A1 on Sheet1 Set CurrentCell = Worksheets("all corrects").Cells(1, 2) 'row 1 column 1 to this... ' start with cell M2 on Sheet1 Set CurrentCell = Worksheets("all corrects").Cells(13, 2) 'row 1 column 13 I note your original remark said "A1", but it probably should have been A2 -- Rick (MVP - Excel) "J.W. Aldridge" wrote in message ... Code works fine, just need minor adjustment to paste to M2 instead of A2. Sub Cop_RowS_To_Sheets_TA() '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 A1 on Sheet1 Set CurrentCell = Worksheets("all corrects").Cells(1, 2) 'row 1 column 1 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 'TO INSERT SHEETS BEFORE A SPECIFIED SHEET, CHANGE NAME BELOW (END) Worksheets.Add(befo=Sheets("TA_END")).Name = CurrentCellValue End If On Error GoTo 0 'reset on error to trap errors again Set Targetsht = ActiveWorkbook.Worksheets(CurrentCellValue) 'note: using CurrentCell.value gave me an error if the value was numeric ' 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 Sub |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change target sheet destination from A2 to M2.
Crazy thing... Data is not in any special format or anything. However.... Getting error stating that the copy and paste areas are not the same size and shape. |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change target sheet destination from A2 to M2.
this went back to pasting to column A on destination worksheet.
|
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change target sheet destination from A2 to M2.
I noticed that there is no Code referring to column. Just rows. Is
that something that can or should be added in? |
#7
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change target sheet destination from A2 to M2.
Whoops... I accidentally reversed things. Use Dave's setup as he has them in
the right order. -- Rick (MVP - Excel) "J.W. Aldridge" wrote in message ... this went back to pasting to column A on destination worksheet. |
#8
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change target sheet destination from A2 to M2.
Thanx...
But each time I tried, I got... error stating that the copy and paste areas are not the same size and shape. Is this because this is trying to paste the row along with the blank columns thereafter into a worksheet starting at M, and running out of space? |
#9
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change target sheet destination from A2 to M2.
If so, is it possible to change this from entirerow to just the range
where the data is (A:G) ? |
#10
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change target sheet destination from A2 to M2.
Set SourceRow = CurrentCell.EntireRow
means that you're going to copy the entire row. You can't paste the entire row and start pasting in column M. So how about: Set SourceRow = CurrentCell.EntireRow.resize(1, 7) ..resize(x,y) says to take x rows and y columns and column G is the 7th column. "J.W. Aldridge" wrote: Crazy thing... Data is not in any special format or anything. However.... Getting error stating that the copy and paste areas are not the same size and shape. -- Dave Peterson |
#11
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change target sheet destination from A2 to M2.
Thanx, but...
Now its copying to the right place, but only one row (one instance) is being copied. Sub Cop_Corrects() '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 A1 on Sheet1 Set CurrentCell = Worksheets("all corrects").Cells(1, 2) 'row 1 Column 1 Do While Not IsEmpty(CurrentCell) CurrentCellValue = CurrentCell.Value Set SourceRow = CurrentCell.EntireRow.Resize(1, 7) 'Check if worksheet exists On Error Resume Next Testwksht = Worksheets(CurrentCellValue).Name If Err.Number = 0 Then 'MsgBox CurrentCellValue & " worksheet Exists" Else 'TO INSERT SHEETS BEFORE A SPECIFIED SHEET, CHANGE NAME BELOW (END) Worksheets.Add(befo=Sheets("TA_END")).Name = CurrentCellValue End If On Error GoTo 0 'reset on error to trap errors again Set Targetsht = ActiveWorkbook.Worksheets(CurrentCellValue) 'note: using CurrentCell.value gave me an error if the value was numeric ' 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, "M") 'do the next cell Set CurrentCell = CurrentCell.Offset(1, 0) Loop End Sub |
#12
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change target sheet destination from A2 to M2.
It sure looks like the original code only copied one row at a time, too.
You may want to look at how Ron de Bruin and Debra Dalgleish approached this kind of thing: Ron de Bruin's EasyFilter addin: http://www.rondebruin.nl/easyfilter.htm Or: Code from Debra Dalgleish'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 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 "J.W. Aldridge" wrote: Thanx, but... Now its copying to the right place, but only one row (one instance) is being copied. Sub Cop_Corrects() '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 A1 on Sheet1 Set CurrentCell = Worksheets("all corrects").Cells(1, 2) 'row 1 Column 1 Do While Not IsEmpty(CurrentCell) CurrentCellValue = CurrentCell.Value Set SourceRow = CurrentCell.EntireRow.Resize(1, 7) 'Check if worksheet exists On Error Resume Next Testwksht = Worksheets(CurrentCellValue).Name If Err.Number = 0 Then 'MsgBox CurrentCellValue & " worksheet Exists" Else 'TO INSERT SHEETS BEFORE A SPECIFIED SHEET, CHANGE NAME BELOW (END) Worksheets.Add(befo=Sheets("TA_END")).Name = CurrentCellValue End If On Error GoTo 0 'reset on error to trap errors again Set Targetsht = ActiveWorkbook.Worksheets(CurrentCellValue) 'note: using CurrentCell.value gave me an error if the value was numeric ' 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, "M") 'do the next cell Set CurrentCell = CurrentCell.Offset(1, 0) Loop End Sub -- Dave Peterson |
#13
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change target sheet destination from A2 to M2.
Ah, I see where you're looping through the cells by using:
set currentcell = currentcell.offset(1,0) Maybe you shouldn't use column A anymore to determine the next row: TargetRow = Targetsht.Cells(Rows.Count, 1).End(xlUp).Row + 1 becomes TargetRow = Targetsht.Cells(Rows.Count, "M").End(xlUp).Row + 1 or whatever column you can trust to have data in it. "J.W. Aldridge" wrote: Thanx, but... Now its copying to the right place, but only one row (one instance) is being copied. Sub Cop_Corrects() '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 A1 on Sheet1 Set CurrentCell = Worksheets("all corrects").Cells(1, 2) 'row 1 Column 1 Do While Not IsEmpty(CurrentCell) CurrentCellValue = CurrentCell.Value Set SourceRow = CurrentCell.EntireRow.Resize(1, 7) 'Check if worksheet exists On Error Resume Next Testwksht = Worksheets(CurrentCellValue).Name If Err.Number = 0 Then 'MsgBox CurrentCellValue & " worksheet Exists" Else 'TO INSERT SHEETS BEFORE A SPECIFIED SHEET, CHANGE NAME BELOW (END) Worksheets.Add(befo=Sheets("TA_END")).Name = CurrentCellValue End If On Error GoTo 0 'reset on error to trap errors again Set Targetsht = ActiveWorkbook.Worksheets(CurrentCellValue) 'note: using CurrentCell.value gave me an error if the value was numeric ' 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, "M") 'do the next cell Set CurrentCell = CurrentCell.Offset(1, 0) Loop End Sub -- Dave Peterson |
#14
Posted to microsoft.public.excel.programming
|
|||
|
|||
Change target sheet destination from A2 to M2.
Thanx a Million!
That worked! |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
copied formulas refer to destination sheet not source sheet | Excel Worksheet Functions | |||
Change auto destination in Save As ??? | New Users to Excel | |||
links in excel change destination after sort | Excel Worksheet Functions | |||
Change Hyperlink Destination Folder | Excel Discussion (Misc queries) | |||
How do you change the destination of "print to file" in excel xp? | Excel Discussion (Misc queries) |