Sub CopyRows()

Dim srcbk As Workbook, srcsht As Worksheet, cel As Range

Dim tgtbk As Workbook, flag As Boolean, L0, L1, wrk As String
ReDim working(0) As String

Set srcbk = ActiveWorkbook
Set srcsht = ActiveSheet
'Find the data.

working(0) = "A" & ActiveCell.Row

For Each cel In Selection.Cells
For L0 = 2 To Cells.SpecialCells(xlCellTypeLastCell).Row
'Case-sensitive.
If Cells(L0, 1).Value = Cells(cel.Row, 1).Value Then

flag = False
For L1 = 0 To UBound(working)
If working(L1) = "A" & L0 Then flag = True
Next
If Not flag Then
ReDim Preserve working(UBound(working) + 1)
working(UBound(working)) = "A" & L0
End If
End If
Next
Next

'This assumes that the workbook is entered as a string value
'(e.g. literally "C:\Apps\File1.xls"), not an Excel reference.
On Error Resume Next

Set tgtbk = Workbooks.Open(Sheets("Sheets1").Range("F2").Value ) 'Location of File1

On Error GoTo 0
If Not (tgtbk Is Nothing) Then
tgtbk.Activate

'Out with the old and in with the new.
Range("A2:A" & _
Cells.SpecialCells(xlCellTypeLastCell).Row).Entire Row.Delete

wrk = Join$(working, ",")
srcsht.Range(wrk).EntireRow.Copy

Range("A2").Select
ActiveSheet.Paste
tgtbk.Save
tgtbk.Close

'Kolom X bevat de Sdl Upload datum

srcsht.Range(wrk).EntireRow.Copy

For Each cel In Range(Replace$(wrk, "A", "X")).Cells

'cel.Value = Date
cel.Value = DateValue(Now) & " / " & TimeValue(Now)
Next
End If

Set cel = Nothing
Set srcsht = Nothing
Set tgtbk = Nothing
Set srcbk = Nothing

'NOW THE MACRO COMES BACK IN THE SHEET WERE IT BEFORE COPIEED THE SELECTED ROWS FROM TO THE OTHER FILE.
'THE ROWS THAT ARE SELECTED ARE BLINKING/FLASHING BU NOT REALLY SELECTED FOR A FURTHER ACTION.
'I NEED TO SELECT THOSE ROWS AS REAL SELECTED AS WHEN YOU SELECT WHOLE ROWS ON THE LEFT HEADINGS.
'NOW I WANT TO RUN THE NEXT MODULE I GET FROM CLAUS, BUT THAT NEEDS SELECTED ROWS :)

End Sub



Sub GetMessage()
Dim rngC As Range
Dim varEmpty() As Variant
Dim n As Long, i As Long
Dim myStr As String

For Each rngC In Intersect(Range("L:L"), Selection)
If Len(rngC) = 0 Then
i = i + 1
ReDim Preserve varEmpty(n)
varEmpty(n) = rngC.Address(0, 0)
n = n + 1
End If
Next
Select Case i
Case 0
Exit Sub
Case 1
myStr = varEmpty(0)
Case Else
myStr = Join(varEmpty, Chr(10))
End Select

MsgBox "Incomplete data in column K." & vbNewLine & "." & vbNewLine & "Ttl empty records = " & i & " st." & vbNewLine & "That are the records" & Chr(10) & myStr & vbNewLine & "." & vbNewLine & "Solve those !." & vbNewLine & "."

End Sub