Copy data from range

J

Jumparound

Hi guys (and girls)

This is my problem:

I got 3 workbooks (lets call them subtest1, subtest2 and subtest3)
filled with data.
All 3 workbooks have a column "D" filled with "open" or "closed"
Now i want a CommandButton that copys all rows that have column "D"
filled with "open" to a new workbook called "total"

How do i do this?

Tnx for your help!
 
J

Joel

This code should work. Change Folder, and sheet Names as required. I put
thhe total into the workbook where tthe macro is located. After the macro is
run you can manually save the file using SaveAs.

Sub GetBooks()

Folder = "C:\Temp\"
BkNames = Array("subtest1", "subtest2", "subtest3")

DestSht = ThisWorkbook.Sheets("Sheet1")
NewRow = 1

For Each Bk In BkNames
FullName = Folder & Bk & ".xls"
Set Bk = Workbooks.Open(Filename:=FullName)
With Bk.Sheets("Sheet1")
LastRow = .Range("D" & Rows.Count).End(xlUp).Row
For RowCount = 1 To LastRow
If UCase(.Range("D" & RowCount)) = "OPEN" Then
.Rows(RowCount).Copy Destination:=DestSht.Rows(NewRow)
NewRow = NewRow + 1
End If
Next RowCount
End With
Bk.Close savechanges:=False
Next Bk

End Sub
 
J

Jumparound

This code should work.  Change Folder, and sheet Names as required.  I put
thhe total into the workbook where tthe macro is located.  After the macro is
run you can manually save the file using SaveAs.

Sub GetBooks()

Folder = "C:\Temp\"
BkNames = Array("subtest1", "subtest2", "subtest3")

DestSht = ThisWorkbook.Sheets("Sheet1")
NewRow = 1

For Each Bk In BkNames
   FullName = Folder & Bk & ".xls"
   Set Bk = Workbooks.Open(Filename:=FullName)
   With Bk.Sheets("Sheet1")
      LastRow = .Range("D" & Rows.Count).End(xlUp).Row
      For RowCount = 1 To LastRow
         If UCase(.Range("D" & RowCount)) = "OPEN" Then
            .Rows(RowCount).Copy Destination:=DestSht.Rows(NewRow)
            NewRow = NewRow + 1
         End If
      Next RowCount
   End With
   Bk.Close savechanges:=False
Next Bk

End Sub









- Show quoted text -
Click to expand...


Thanks a lot!
It works like a charm :-D

Many many many thanks!
 
Top