Copy and paste range instead of entire row


J

J.W. Aldridge

Tried this code, but getting errors on "copy and paste area are not
the same size and shape".
Any way to change this code, to copy range instead of entire row?
Orignal Data is in column A:G, destination is M2.


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


'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, 13)


'do the next cell
Set CurrentCell = CurrentCell.Offset(1, 0)
Loop
End Sub
 
Ad

Advertisements

J

J.W. Aldridge

thanx but cancel this...

Experts returned to my previous post. Hoping to work this out.

THanx
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top