Change target sheet destination from A2 to M2.

[J.W. Aldridge]

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(before:=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]

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")

 

[Rick Rothstein]

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

 

[J.W. Aldridge]

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.

 

[J.W. Aldridge]

this went back to pasting to column A on destination worksheet.

 

[J.W. Aldridge]

I noticed that there is no Code referring to column. Just rows. Is
that something that can or should be added in?

 

[Rick Rothstein]

Whoops... I accidentally reversed things. Use Dave's setup as he has them in
the right order.

 

[J.W. Aldridge]

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?

 

[J.W. Aldridge]

If so, is it possible to change this from entirerow to just the range
where the data is (A:G) ?

 

[Dave Peterson]

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]

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(before:=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]

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

 

[Dave Peterson]

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]

Thanx a Million!
That worked!