Solved: copy and transfer specific rows

[joanna_gr]

Hi all. I would like to have your help on the following. I have a form as the attachment (something like timesheet). I need a macro to select some specific cells, especially those who are filled in with data and transfer them to another sheet named "transfdata". Plase see the attachement to have an idea what I am asking of. Can anyone help me on this please?

[mdmackillop]

Hi Joanna,
Try the following.

Option Explicit
Sub CopyData()
Dim Cols, c, i As Long, TrData As Range
Cols = Array(4, 7, 10, 13)
For Each c In Cols
For i = 10 To 16
If Cells(i, c) <> "" Then
Set TrData = Sheets("transfdata").[A65536].End(xlUp).Offset(1).Range("A1:F1")
TrData(1) = Cells(8, c - 1)
TrData(2) = Cells(i, 1)
TrData(3) = Cells(i, 2)
TrData(4) = Cells(i, c - 1)
TrData(5) = Cells(i, c)
TrData(6) = Cells(i, c + 1)
End If
Next
Next
Set TrData = Nothing
End Sub

[joanna_gr]

PERFECT! thanks a lot ! :yay

[mdmackillop]

HTH
MD