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:
'
' 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: