PDA

View Full Version : Solved: copy row into single worksheet



noobie
11-19-2006, 08:39 PM
Sub Datamove()
'
' Datamove Macro
' Macro recorded 10/13/2006 by Andy Lewis
'
'Baseline variable list
Set sht1 = Worksheets("Sheet1")
'Counters for respective worksheet pages
Dim i As Integer
Dim k As Integer 'Row counter for sht1
Dim v As Integer
Dim tick As Long 'Counter for records copied
Dim eRow As Long 'Last row on sht2
Dim sht2 As Worksheet 'worksheet that will change name depending on a value
Dim Tac As String, Trep As String, Tindt As String 'values based on the find function
Application.ScreenUpdating = False
k = 2
v = 2
tick = 0
With sht1
For v = 2 To sht1.Cells(Rows.Count, "A").End(xlUp).Row 'Goes through each row on sht1
Dim shName As String
shName = sht1.Cells(k, "H")
Set sht2 = Sheets("Sheet2")
eRow = sht2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
Dim c As Range
Set c = sht2.Columns(2).Find(sht1.Cells(k, "B").Value)
If c Is Nothing Then 'If it finds no match, it copies the row from sht1 to the respective sheet
Set c = Nothing
sht1.Rows(k).Copy Destination:=sht2.Rows(eRow)
tick = tick + 1
Else 'If it does find a match value wise, it compares those two cells as well to see if they match
'MsgBox "Already Exists"
Tac = c.Address
Trep = c.Offset(0, 2).Value
Tindt = c.Offset(0, 3).Value
If Trep <> sht1.Cells(k, "D").Value Or Tindt <> sht1.Cells(k, "E").Value Then
sht1.Rows(k).Copy Destination:=sht2.Rows(eRow)
tick = tick + 1
'If it finds that either of the two variables don't match - it will copy the row over
End If
'v = v + 1
'Does nothing else
End If
k = k + 1
Next v
MsgBox "Records copied: " & tick
End With
Application.ScreenUpdating = True
End Sub




Hi all,
I took this from another thread. It was what i need. BUT! i need to tweak the code abit. I do not want it to go thru every row in Sheet 1. I only want it to find the last row in a specified range (A2:M15). May i know how do i modify the above code?

Many thanks,

noobie.:bug:

Bartek
11-20-2006, 01:20 AM
Hi all,
I took this from another thread. It was what i need. BUT! i need to tweak the code abit. I do not want it to go thru every row in Sheet 1. I only want it to find the last row in a specified range (A2:M15). May i know how do i modify the above code?

Try something like this (not tested). Replace the lines of code:


For v = 2 To sht1.Cells(Rows.Count, "A").End(xlUp).Row 'Goes through each row on sht1
...
Next v


With:


v = Intersect(sht1.UsedRange, Range("a2:m15")).Row + Intersect(sht1.UsedRange, Range("a2:m15")).Rows.Count - 1
'Goes through each row on sht1
Dim shName As String
shName = sht1.Cells(k, "H")
Set sht2 = Sheets("Sheet2")
eRow = sht2.Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Row
Dim c As Range
Set c = sht2.Columns(2).Find(sht1.Cells(k, "B").Value)
If c Is Nothing Then 'If it finds no match, it copies the row from sht1 to the respective sheet
Set c = Nothing
sht1.Rows(k).Copy Destination:=sht2.Rows(eRow)
tick = tick + 1
Else 'If it does find a match value wise, it compares those two cells as well to see if they match
'MsgBox "Already Exists"
Tac = c.Address
Trep = c.Offset(0, 2).Value
Tindt = c.Offset(0, 3).Value
If Trep <> sht1.Cells(k, "D").Value Or Tindt <> sht1.Cells(k, "E").Value Then
sht1.Rows(k).Copy Destination:=sht2.Rows(eRow)
tick = tick + 1
'If it finds that either of the two variables don't match - it will copy the row over
End If
'v = v + 1
'Does nothing else
End If
k = k + 1


The value of V is set to last used row in range("a2:m25"), even if some rows / columns at the beginning, middle or end of this range are empty.

noobie
11-20-2006, 02:01 AM
Thanks for ya reply. I tried your code but it did not managed 2 find e last row of Sheet1 to be copied to Sheet2. What I meant was to conduct a find for the last row in the range ("A2:M15") and copy it to Sheet2.

sorry of my unclear explaination.

Many thanks though

Charlize
11-20-2006, 04:16 AM
Maybe this will do it. Copy last row of sheet 1 to last empty row of sheet2.

sub copy_it()
dim lrow as long
dim lrow2 as long
lrow = sheets(1).Range("A" & Rows.Count).End(xlUp).Row
lrow2 = sheets(2).Range("A" & Rows.count).End(xlUp).Row
lrow2 = lrow2 + 1
Sheets(1).Range("A" & lrow & ":M" & lrow).Copy Sheets(2).Range("A" & lrow2)
end sub
Charlize
ps.: column A must always be filled in.

noobie
11-20-2006, 05:58 PM
I tried your macro. Is it possible to
-conduct a search from row 2 to row 15 & from column a to m.
-exclude column J in a copying

I attached a sample workbook for your better understanding.

sorry for the inconvience caused. Your guys have already been a great help to me.:thumb

Thanks alot!

rbrhodes
11-20-2006, 08:11 PM
noobie,

This will check Sheet1, range A2 to A15 for data and copy what it finds to the first blank row in Sheet2.



Sub copy_it()

Dim lrow As Long
Dim lrow2 As Long

'Check if row 15 is blank
If Sheets(1).Range("A15") = "" Then
'Row 15 is blank, find first non blank row of data
lrow = Sheets(1).Range("A16").End(xlUp).Row
Else
'Row 15 has data, end at row 15
lrow = 15
End If

'Get first blank row in sheet2
lrow2 = Sheets(2).Range("A65536").End(xlUp).Row + 1

'Copy sheet1, A2:I + last row, to sheet2
Sheets(1).Range("A2:I" & lrow).Copy Sheets(2).Range("A" & lrow2)
' (skip Sheet1, Col J)
'Copy sheet1 K2:M + last row to sheet2
Sheets(1).Range("K2:M" & lrow).Copy Sheets(2).Range("J" & lrow2)
End Sub


HTH,

dr

noobie
11-20-2006, 08:39 PM
Thanks for your response rbrhodes! It worked very much how i wanted it to. but it does not copy the last row. It copies all the other rows too. I tried to modify the macro using my limted knowledge but to no avail.

I'll appreciate alot if you could provide me with any suggestions.

Thanks!

rbrhodes
11-20-2006, 10:53 PM
OOPS!

Just the last row.



Sub copy_it()

Dim lrow As Long
Dim lrow2 As Long

'Check if row 15 is blank
If Sheets(1).Range("A15") = "" Then
'Row 15 is blank, find first non blank row
lrow = Sheets(1).Range("A16").End(xlUp).Row
Else
'Row 15 has data, end at row 15
lrow = 15
End If

'Get first blank row in sheet2
lrow2 = Sheets(2).Range("A65536").End(xlUp).Row + 1

'Copy LAST row of data in Sheet1, Col A to I
Sheets(1).Range("A" & lrow & ":I" & lrow).Copy Sheets(2).Range("A" & lrow2)

'Copy LAST row of data in Sheet1, Col K to M (skip Sheet1, Col J)
Sheets(1).Range("K" & lrow & ":M" & lrow).Copy Sheets(2).Range("J" & lrow2)
End Sub


The 'secret' is to concatentate (join together) the literals with the variables. The concatentate char is '&'. Example:

Variable name is 'lrow' and lrow = 13, or any other number.

If literal range is "A13:K13" ( note the double quotes)

then to get A(lrow) to K(lrow)

Concatentated string is

"A" & lrow & ":K" & lrow

Hope this explanation helps!

Cheers,

dr

noobie
11-20-2006, 11:02 PM
Thanks so much for your patience as well as your kind explaination! I shall marked this solved.

Much thanks for those who offered me help previously too!

Cheers,
noobie.:cloud9: