Dear Master,
Could you please advise
I would like copy the data in the new row other sheet
below is the screen shoot what should it be
Sheet 1
There are date, people , and color + number
https://drive.google.com/file/d/0B995E_xrlb3STzd5VG5Jd2lmdVU/view?usp=sharing
Sheet 2
If color is brown then copy value from sheet 1 and paste to sheet 2 with name Color A for brown ( depend on the date and people)
if color is yellow then copy value from sheet 1 create new row below brown Name color C for yellow ( Depend on the date )
if no color then do nothing
https://drive.google.com/file/d/0B995E_xrlb3SQk40ZWk4dU0tSzQ/view?usp=sharing
below is my code, but doesn't work . Please help and advise
Dim k, x
Dim inter As Worksheet
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Set inter = ThisWorkbook.Worksheets("Sheet2")
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set rng = Range("People")
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
For Each cell In rng
For k = 6 To 12
If ws.Cells(cell.ROW, k).Interior.ColorIndex = 53 Then
inter.Cells(cell.ROW + x, 5).Value = "A"
inter.Cells(cell.ROW + x, k).Value = ws.Cells(cell.ROW, k).Value
ElseIf ws.Cells(cell.ROW, k).Interior.ColorIndex = 37 Then
inter.Cells(cell.ROW + x, 5).Value = "B"
inter.Cells(cell.ROW + x, k).Value = ws.Cells(cell.ROW, k).Value
ElseIf ws.Cells(cell.ROW, k).Interior.ColorIndex = 6 Then
inter.Cells(cell.ROW + x, 5).Value = "C"
inter.Cells(cell.ROW + x, k).Value = ws.Cells(cell.ROW, k).Value
ElseIf ws.Cells(cell.ROW, k).Interior.ColorIndex = 55 Then
inter.Cells(cell.ROW + x, 5).Value = "D"
inter.Cells(cell.ROW + x, k).Value = ws.Cells(cell.ROW, k).Value
ElseIf ws.Cells(cell.ROW, k).Interior.ColorIndex = 46 Then
inter.Cells(cell.ROW + x, 5).Value = "D"
inter.Cells(cell.ROW + x, k).Value = ws.Cells(cell.ROW, k).Value
Else
End If
x = x + 1
Next k
Could you please advise
I would like copy the data in the new row other sheet
below is the screen shoot what should it be
Sheet 1
There are date, people , and color + number
https://drive.google.com/file/d/0B995E_xrlb3STzd5VG5Jd2lmdVU/view?usp=sharing
Sheet 2
If color is brown then copy value from sheet 1 and paste to sheet 2 with name Color A for brown ( depend on the date and people)
if color is yellow then copy value from sheet 1 create new row below brown Name color C for yellow ( Depend on the date )
if no color then do nothing
https://drive.google.com/file/d/0B995E_xrlb3SQk40ZWk4dU0tSzQ/view?usp=sharing
below is my code, but doesn't work . Please help and advise
Dim k, x
Dim inter As Worksheet
Dim ws As Worksheet
Dim rng As Range
Dim cell As Range
Set inter = ThisWorkbook.Worksheets("Sheet2")
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set rng = Range("People")
oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
For Each cell In rng
For k = 6 To 12
If ws.Cells(cell.ROW, k).Interior.ColorIndex = 53 Then
inter.Cells(cell.ROW + x, 5).Value = "A"
inter.Cells(cell.ROW + x, k).Value = ws.Cells(cell.ROW, k).Value
ElseIf ws.Cells(cell.ROW, k).Interior.ColorIndex = 37 Then
inter.Cells(cell.ROW + x, 5).Value = "B"
inter.Cells(cell.ROW + x, k).Value = ws.Cells(cell.ROW, k).Value
ElseIf ws.Cells(cell.ROW, k).Interior.ColorIndex = 6 Then
inter.Cells(cell.ROW + x, 5).Value = "C"
inter.Cells(cell.ROW + x, k).Value = ws.Cells(cell.ROW, k).Value
ElseIf ws.Cells(cell.ROW, k).Interior.ColorIndex = 55 Then
inter.Cells(cell.ROW + x, 5).Value = "D"
inter.Cells(cell.ROW + x, k).Value = ws.Cells(cell.ROW, k).Value
ElseIf ws.Cells(cell.ROW, k).Interior.ColorIndex = 46 Then
inter.Cells(cell.ROW + x, 5).Value = "D"
inter.Cells(cell.ROW + x, k).Value = ws.Cells(cell.ROW, k).Value
Else
End If
x = x + 1
Next k
Last edited: