Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations John Tel on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Copy a columns value to another tab inside a loop

Status
Not open for further replies.

Mack2

Instructor
Mar 12, 2003
336
US
My code is testing values in column E: So if it meets a criteria(a unique part), it creates a new tab within the worksheet. When it meets the criteria, I would like the code to copy the value in column G: of the same row to the tab it just created. The code I have is below. I have tried using the offset(0,2) property, but no luck...THANKS!

For Each cell In Sheets(1).Range("E2:E140")
If cell.Value <> cell.Offset(-1, 0).Value Then
Selection.Offset(0, 2).Select
Selection.Copy
Sheets.Add , Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = cell.Value
ActiveSheet.Select
ActiveSheet.Paste
End If
Next cell
 

Hi,

You selected nothing. However, I advise to NOT use the Select method...
Code:
[b]
'create the new sheet here NOT in the loop[/b]
set wsNew = Sheets.Add Sheets(Sheets.count)
For Each cell In Sheets(1).Range("E2:E140")
    If cell.Value <> cell.Offset(-1, 0).Value Then
[b][red]'what was selected here??? Is it Cell[/red][/b]
        Cell.Offset(0, 2).Copy wsNew.Cells(wsNew.[A1].CurrentRegion.rows.count+1, 1)
    End If
Next cell


Skip,

[glasses] [red][/red]
[tongue]
 

If cell.Value <> cell.Offset(-1, 0).Value Then

If the values in the cells are not the same, that means it is a new part, and I need to create a new tab, and then copy the cell that are two columns to the right of the current cell. Notice the line No column starts at a new part. THANKS! Hope this helps

Item No Line No Rpt Line Contents
G1B-010 1 want to copy this cell to the new tab 1
G1B-010 2 want to copy this cell to the new tab 1
G1B-010 3 want to copy this cell to the new tab 1
G1B-011 1 want to copy this cell to the new tab 2
G1B-011 2 want to copy this cell to the new tab 3
G1B-012 1 want to copy this cell to the new tab 4

 



Why not use a PivotTable report to report any part. There are a plethora of tools in Excel for this sort of thing. I would not use your method.

Skip,

[glasses] [red][/red]
[tongue]
 
The results has to be emailed to a customer. Then the customer will make changes and send it back to us.
 


AutoFilter

Loop based on a list of unique Part Numbers

Filter criteria:=NextPN

Sheet(1).[E2].CurrentRegion.SpecialCells(xlCellTypeVisible).Copy

Add Sheet

Paste Special -- VALUES.

Skip,

[glasses] [red][/red]
[tongue]
 
Thanks Skip! I ended up getting it.

Dim CellValue As String
Dim SheetName As String
Dim PastValue As String
Dim SheetCount As Double

Range("e2").Select
For Each cell In Sheets(1).Range("E2:E140")

If cell.Value <> cell.Offset(-1, 0).Value Then
Selection.Copy
Sheets.Add , Sheets(Sheets.Count)
Sheets(Sheets.Count).Name = cell.Value
SheetName = Sheets(Sheets.Count).Name
Sheets("Sheet 1").Select
Else
cell.Offset(0, 2).Select
ActiveCell.Copy
Sheets(SheetName).Activate
ActiveCell.Offset(1, 0).Select
ActiveCell.PasteSpecial
Sheets("Sheet 1").Select
End If
Next cell
 



Why loop thru each cell in the range when you could loop thru each UNIQUE PN in the range, filter and copy? It would run alot faster.

Skip,

[glasses] [red][/red]
[tongue]
 
I still need to test for each item. If the "next" item in the range is not a new item, then I need to copy the contents to that part numbers tab.
 


Not if you FILTER on the "ITEM". Then thats ALL that is displayed.

Skip,

[glasses] [red][/red]
[tongue]
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top