VBA - Looking For Best Way(s) To Copy Data To Another Sheet

[kelly mort]

Hello,
I have this code that I am trying to use to copy some data from one sheet to another. It is copying though yet the final output is not something that I am happy with.
At the time of copying, "ITEM 6" will be the below all the other items on the data1 sheet – I am sorting with the items column (col C).
After the copy, only the last "ITEM 6" member from data1 sheet appears for all the "ITEM 6" records.
Is there a problem with this code and or how best can I copy the said data to the data2 sheet?
Thanks in advance.

Dim e&, ls&, lr&, MyCells As Range
Dim T1 As Worksheet, S1 As Worksheet

Set T1 = Sheets(“Data1”)
Set S1 = Sheets(“Data2”)

e = 0
lr = T1.Range("A" & Rows.Count).End(xlUp).Row
If lr < 7 Then lr = 7

For Each MyCells In T1.Range("C7:C" & lr)
   If MyCells = "ITEM 6" Then
      T1.Range("A" & lr & ":U" & lr).Copy S1.Cells(Rows.Count, "A").End(xlUp).Offset(1)
      T1.Range("A" & MyCells.Row & ":U" & MyCells.Row).ClearContents
      ls = S1.Range("A" & Rows.Count).End(xlUp).Row
      If ls < 7 Then ls = 7

      With S1.Range("A7:A" & ls)
         Do
            e = e + 1
         Loop Until IsError(Application.Match(e, S1.Cells, 0))
     End With
     S1.Cells(ls, "A") = e
  End If
Next MyCells

 

[Zot]

I see that

T1.Range("A" & lr & ":U" & lr).Copy S1.Cells(Rows.Count, "A").End(xlUp).Offset(1)
T1.Range("A" & MyCells.Row & ":U" & MyCells.Row).ClearContents

you are copying same Range("A" & lr) each time MyCells= "ITEM 6" and then Clear Range("A" & MyCells.Row)? Why is that?

 

[kelly mort]

I see that

T1.Range("A" & lr & ":U" & lr).Copy S1.Cells(Rows.Count, "A").End(xlUp).Offset(1)
T1.Range("A" & MyCells.Row & ":U" & MyCells.Row).ClearContents

you are copying same Range("A" & lr) each time MyCells= "ITEM 6" and then Clear Range("A" & MyCells.Row)? Why is that?

I am clearing that row (range) because I don't want to have those records on the data1 sheet after copying.

It's like moving the range of data from the data1 sheet to the data2 sheet.

I am not familiar with the "move" syntax and I don't want to interfere with my sheet formating.

Like I said before, I am looking for a fix and a better way to handle my problem.

 

[Zot]

Hard to visualize. Can you copy or upload sample data?

 

[aRandomHelper]

Not sure what the blue segment of the code does, but your problem is probably because you are only copying the last row with lr. Change it to reference MyCells.Row and it should work fine.

Dim e&, ls&, lr&, MyCells As Range
Dim T1 As Worksheet, S1 As Worksheet

Set T1 = Sheets(“Data1”)
Set S1 = Sheets(“Data2”)

e = 0
lr = T1.Range("A" & Rows.Count).End(xlUp).Row
If lr < 7 Then lr = 7

For Each MyCells In T1.Range("C7:C" & lr)
   If MyCells = "ITEM 6" Then
      T1.Range([COLOR=rgb(226, 80, 65)]"A" & MyCells.Row & ":U" & MyCells.Row[/COLOR]).Copy S1.Cells(Rows.Count, "A").End(xlUp).Offset(1)
      T1.Range("A" & MyCells.Row & ":U" & MyCells.Row).ClearContents
      ls = S1.Range("A" & Rows.Count).End(xlUp).Row
      If ls < 7 Then ls = 7

[COLOR=rgb(44, 130, 201)]      With S1.Range("A7:A" & ls)
         Do
            e = e + 1
         Loop Until IsError(Application.Match(e, S1.Cells, 0))
     End With
     S1.Cells(ls, "A") = e[/COLOR]
  End If
Next MyCells

 

[aRandomHelper]

So apparently I can't use color tags within VBA code tags, and I can't edit post. So here's the revised post:

Dim e&, ls&, lr&, MyCells As Range
Dim T1 As Worksheet, S1 As Worksheet

Set T1 = Sheets(“Data1”)
Set S1 = Sheets(“Data2”)

e = 0
lr = T1.Range("A" & Rows.Count).End(xlUp).Row
If lr < 7 Then lr = 7

For Each MyCells In T1.Range("C7:C" & lr)
   If MyCells = "ITEM 6" Then
      T1.Range("A" & MyCells.Row & ":U" & MyCells.Row).Copy S1.Cells(Rows.Count, "A").End(xlUp).Offset(1)
      T1.Range("A" & MyCells.Row & ":U" & MyCells.Row).ClearContents
      ls = S1.Range("A" & Rows.Count).End(xlUp).Row
      If ls < 7 Then ls = 7

      With S1.Range("A7:A" & ls)
         Do
            e = e + 1
         Loop Until IsError(Application.Match(e, S1.Cells, 0))
     End With
     S1.Cells(ls, "A") = e
  End If
Next MyCells

 

[Zot]

Not sure what the blue segment of the code does, but your problem is probably because you are only copying the last row with lr. Change it to reference MyCells.Row and it should work fine.

Dim e&, ls&, lr&, MyCells As Range
Dim T1 As Worksheet, S1 As Worksheet

Set T1 = Sheets(“Data1”)
Set S1 = Sheets(“Data2”)

e = 0
lr = T1.Range("A" & Rows.Count).End(xlUp).Row
If lr < 7 Then lr = 7

For Each MyCells In T1.Range("C7:C" & lr)
   If MyCells = "ITEM 6" Then
      T1.Range([COLOR=rgb(226, 80, 65)]"A" & MyCells.Row & ":U" & MyCells.Row[/COLOR]).Copy S1.Cells(Rows.Count, "A").End(xlUp).Offset(1)
      T1.Range("A" & MyCells.Row & ":U" & MyCells.Row).ClearContents
      ls = S1.Range("A" & Rows.Count).End(xlUp).Row
      If ls < 7 Then ls = 7

[COLOR=rgb(44, 130, 201)]      With S1.Range("A7:A" & ls)
         Do
            e = e + 1
         Loop Until IsError(Application.Match(e, S1.Cells, 0))
     End With
     S1.Cells(ls, "A") = e[/COLOR]
  End If
Next MyCells

That is what I was asking? Why copy the same row over and over again and after copy delete another row

 

[kelly mort]

Thanks guys. It's working now.

It's funny how I miss that! Lol.