Copy down 1 column to the left

[Peruanos72]

I have the following code that:

1. finds a cell Ex: B13
2. copies down from that cell Ex: B13:B15 (original data)
3. moves left one cell and pastes down Ex: A13:A15

The code I have then copies down from B13 to B15 and deletes the data in the
cell at the top (B13). This procedure is down several time in the document
and the ranges change each day. What I want it to do is copy down from
A13:A15, one column over from the original column of data. Anyone know how to
fix this??? Thanks in advance.

 

[Peruanos72]

Here is the code:

Range("A1").Select
Set c = Cells.find(What:="ASHELTON", LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not c Is Nothing Then
Set DataRange = Range(c, c.End(xlDown))
DataRange.Copy _
Destination:=c.Offset(0, -1)
Application.CutCopyMode = False



Set lastcell = c.End(xlDown)
Set DataRange = Range(c, lastcell)
DataRange.Copy _
Destination:=c.Offset(0, -1)
c.Copy Destination:=Range(c, lastcell)
c.ClearContents


firstAddress = c.Address
Do
Set c = Cells.find(What:="BAHOUST", _
After:=c, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)


If Not c Is Nothing Then
Set DataRange = Range(c, c.End(xlDown))
DataRange.Copy _
Destination:=c.Offset(0, -1)

Application.CutCopyMode = False


Set lastcell = c.End(xlDown)
Set DataRange = Range(c, lastcell)
DataRange.Copy _
Destination:=c.Offset(0, -1)
c.Copy Destination:=Range(c, lastcell)
c.ClearContents



End If



firstAddress = c.Address

Do
Set c = Cells.find(What:="CDMCNEAL", _
After:=c, _
LookIn:=xlFormulas, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)


If Not c Is Nothing Then
Set DataRange = Range(c, c.End(xlDown))
DataRange.Copy _
Destination:=c.Offset(0, -1)
Application.CutCopyMode = False

End If

 

[Don Guillett]

It may be easier to just send me your workbook to the address below along
with this msg copied into an inserted sheet and a clear explanation with
before/after examples. Looks like FINDNEXT in an array.

 

[Don Guillett]

I sent this to fill in the employee name

Sub fillitin()
With Columns(2)
Set c = .Find(What:="Date", After:=.Cells(1, 2), LookIn:=xlValues, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not c Is Nothing Then
firstAddress = c.Address
Do
mc = Application.Count(Range(c.Offset(2), c.Offset(2).End(xlDown)))
c.Offset(3, -1).Resize(mc) = c.Offset(2)
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
End Sub