Am I being Ignored, or is my problem too hard?
Not tested much -- but it did compile.
Option Explicit
Sub testme()
Dim TempWks As Worksheet
Dim myCell As Range
Dim DestCell As Range
Dim InputRng As Range
Dim TempCell As Range
Dim TempRngToCheck As Range
With Worksheets("sheet2")
Set InputRng = .Range("E1", .Cells(.Rows.Count, "E").End(xlUp))
End With
With Worksheets("sheet3")
'column A of the next row (based on column K
Set DestCell = .Cells(.Rows.Count, "K").End(xlUp).Offset(1, -10)
End With
For Each myCell In InputRng.Cells
Set TempWks = Nothing
On Error Resume Next
Set TempWks = Workbooks.Open(Filename:=myCell.Value).Worksheets( 1)
On Error GoTo 0
If TempWks Is Nothing Then
myCell.Offset(0, 1).Value = "Missing file!"
Else
With TempWks
Set TempRngToCheck _
= .Range("k1", .Cells(.Rows.Count, "K").End(xlUp))
End With
For Each TempCell In TempRngToCheck.Cells
If LCase(TempCell.Value) = LCase("Q") Then
'found a match
TempCell.EntireRow.Resize(1, 8).Copy _
Destination:=DestCell
Set DestCell = DestCell.Offset(1, 0)
End If
Next TempCell
TempWks.Parent.Close savechanges:=False
myCell.Offset(0, 1).Value = "Done"
End If
Next myCell
End Sub
sharpie23 wrote:
I ahve posted a 3 times over the past 2 days the same problem and have
gotten no respones.
If no one knows how, or it is not possible, Please let me know.
Any response is a good resonse at this point
Again here is my problem.
I am trying to write a Sub that will lookup the 36-40 file names on
sheet(2) column E of my MAIN wrkbook. It will then go into each of the
36-40 wrkbooks , sheet(1) of each wrkbook, and search down column K.
Everywhere there is a "Q" in a column it will copy all info in that row
(from column A to H) and then paste that info on Sheet(3) of the MAIN
wrkbook. Obviously each new paste will need to be placed at the first
empty row.
Thanks
Ryan
--
Dave Peterson
|