Copy cells from one file into another

  • Thread starter Thread starter Lenchik
  • Start date Start date
L

Lenchik

Hello,

what would be the easiest way to go through the a column in one file
and find all the times that exceed 15 minutes, pull up the cells
within that row with names and record these cells into another file
after the last filled row....

Here's a part of the code I am trying to write.... it only records the
cells of the latest time it finds into the row 251, not the first
available one :(

Dim aPath, aRange, aSheet As String
Dim R, i, j As Integer

aPath = "\\servername\"
aFile = "FileName.xls"
aSheet = "SheetName"

Dim mybook As Workbook, xlsheet As Worksheet

Set mybook = Workbooks.Open(aPath & aFile)

For i = 3 To 250


respTime = mybook.Worksheets(hdSheet).Range("H" & i).Value

If (respTime <> "") Then
respMins = Hour(respTime) * 60 + Minute(respTime)

If (respMins > 15) Then

' doesn't work as I want it
R = Range("A65536").End(xlUp).Offset(1, 0).Row
Worksheets("Weekly").Cells(R, 1) =
mybook.Worksheets(hdSheet).Range("E" & i).Value
Worksheets("Weekly").Cells(R, 2) =
mybook.Worksheets(hdSheet).Range("H" & i).Value
Worksheets("Weekly").Cells(R, 3) =
mybook.Worksheets(hdSheet).Range("B" & i).Value

End If
End If

Next i


mybook.Close savechanges:=False
 
Hi

When you Dim items, you have to use each one explicitly on each row,
otherwise only the last one takes the dimension you have set, the others
will be variants.

Try the following code.

Sub copyTime()
Dim aPath As String, afile As String
Dim lr As Long, i As Long, respmins As Long
Dim resptime
Dim mybook As Workbook
Dim wss As Worksheet ' Source Sheet
Dim wsd As Worksheet ' Destination Sheet

aPath = "\\servername\"
afile = "FileName.xls"
Set mybook = Workbooks.Open(aPath & afile)
Set wss = mybook.Sheets("hdSheet")
Set wsd = mybook.Sheets("Weekly")
lr = wsd.Cells(Rows.Count, "A").End(xlUp).Row + 1

For i = 3 To 250
resptime = wss.Range("H" & i).Value

If resptime <> "" Then
respmins = Hour(resptime) * 60 + Minute(resptime)

If respmins > 15 Then
wsd.Cells(lr, 1) = wss.Range("E" & i)
wsd.Cells(lr, 2) = wss.Range("H" & i)
wsd.Cells(lr, 3) = wss.Range("B" & i)
lr = lr + 1
End If
End If
Next i
wsd.Columns("B:B").NumberFormat = "h:mm"

' mybook.Close savechanges:=False

End Sub

NOTE
I have remmed out your last line.
I cannot believe you mean to close the file without saving - otherwise the
whole exercise will have been pointless.
If the destination sheet is an a separate workbook, you will need to Set
that, and set the wsd Destination sheet to be that Workbook and that sheet.
If that is the case, then the Source workbook can be closed without saving,
but do remember to save the destination workbook.
 
Back
Top