Macro needed to extract a text in particular cell in a workbook

[vignesh_thegame]

Hi,
i have around 1000 workbook with same formats in a folder, i need a macro that opens all the workbook and copy ROW 5 text alone and paste this in another excel one by one...

i have given a example below of how my excel is.... i need to extract the "Upper Saddle River, NJ" text which was on column A,B,C in row 5 to another excel. This macro must open all my 1000 workbooks and extract the text and place in a single excel one by one.. Can any one help me on this.???
[TABLE="width: 1280"]
<tbody>[TR]
[TD="class: xl65, width: 64"][/TD]
[TD="class: xl75, width: 64"]A[/TD]
[TD="class: xl75, width: 64"]B[/TD]
[TD="class: xl75, width: 64"]C[/TD]
[TD="class: xl75, width: 64"]D[/TD]
[TD="class: xl75, width: 64"]E[/TD]
[TD="class: xl75, width: 64"]F[/TD]
[TD="class: xl75, width: 64"]G[/TD]
[TD="class: xl75, width: 64"]H[/TD]
[TD="class: xl75, width: 64"]I[/TD]
[TD="class: xl75, width: 64"]J[/TD]
[TD="class: xl75, width: 64"]K[/TD]
[TD="class: xl75, width: 64"]L[/TD]
[TD="class: xl75, width: 64"]M[/TD]
[TD="class: xl75, width: 64"]N[/TD]
[TD="class: xl75, width: 64"]O[/TD]
[TD="class: xl75, width: 64"]P[/TD]
[TD="class: xl75, width: 64"]Q[/TD]
[TD="class: xl75, width: 64"]R[/TD]
[TD="class: xl75, width: 64"]S[/TD]
[/TR]
[TR]
[TD="class: xl75, align: right"]1[/TD]
[TD="class: xl66, width: 192, colspan: 3"]Attn:[/TD]
[TD="class: xl67, width: 1024, colspan: 16"][/TD]
[/TR]
[TR]
[TD="class: xl75, align: right"]2[/TD]
[TD="class: xl68, width: 192, colspan: 3"]Savoula Amanatidis[/TD]
[TD="class: xl67, width: 320, colspan: 5"][/TD]
[TD="class: xl66, width: 512, colspan: 8"]Invoice Date:[/TD]
[TD="class: xl69, width: 192, colspan: 3"]12-17-2013[/TD]
[/TR]
[TR]
[TD="class: xl75, align: right"]3[/TD]
[TD="class: xl68, width: 192, colspan: 3"]Prentice Hall - ECP[/TD]
[TD="class: xl67, width: 320, colspan: 5"][/TD]
[TD="class: xl66, width: 512, colspan: 8"]LW ME Job #:[/TD]
[TD="class: xl70, width: 192, colspan: 3"]9482[/TD]
[/TR]
[TR]
[TD="class: xl75, align: right"]4[/TD]
[TD="class: xl68, width: 192, colspan: 3"]1 Lake Street[/TD]
[TD="class: xl67, width: 320, colspan: 5"][/TD]
[TD="class: xl66, width: 512, colspan: 8"]P.O. #:[/TD]
[TD="class: xl68, width: 192, colspan: 3"]0411662826-1[/TD]
[/TR]
[TR]
[TD="class: xl75, align: right"]5[/TD]
[TD="class: xl68, width: 192, colspan: 3"]Upper Saddle River, NJ[/TD]
[TD="class: xl71, width: 320, colspan: 5"]07458[/TD]
[TD="class: xl66, width: 512, colspan: 8"]Invoice #:[/TD]
[TD="class: xl68, width: 192, colspan: 3"]26103 F[/TD]
[/TR]
[TR]
[TD="class: xl75, align: right"]6[/TD]
[TD="class: xl72"]Final invoice on your title, Troyka[/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[/TR]
[TR]
[TD="class: xl75, align: right"]7[/TD]
[TD="class: xl74"]Quick Access Compact[/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[TD="class: xl73"][/TD]
[/TR]
</tbody>[/TABLE]

 

[ParamRay]

.
.

Please try the following macro. You don't need to have any of your workbooks already open in order to run the macro; simply run it from a new workbook.

Before running, you'll first need to change the line SFold = "C:\Users\jsmith\Desktop" to match the path where your workbooks are located.

Please also note that, if you're looping through 1,000+ workbooks, the macro will likely take some time to run. Therefore, I've placed an alert at the end that will tell you when it has finished running.

Sub Copy_A5_Value()

    'For source books:
    Dim SFold As String
    Dim SFile As String
    Dim SPath As String
    Dim SBook As Workbook
    Dim SNumb As Long
    
    'For destination book:
    Dim DBook As Workbook
    
    'Set folder containing source books
    'Change as necessary...
    SFold = "C:\Users\jsmith\Desktop"
    
    SFile = Dir(SFold & Application.PathSeparator & "*.xl*")
    
    'Exit if no source books found
    If SFile = vbNullString Then
        MsgBox _
            Prompt:="No files found.", _
            Buttons:=vbCritical
        Exit Sub
    End If
    
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    
    'Create destination book
    Set DBook = Workbooks.Add
    
    'Loop through source
    'books and copy
    'values from cell A5...
    
    SNumb = 0
    Do While SFile <> vbNullString
        SNumb = SNumb + 1
        SPath = SFold & Application.PathSeparator & SFile
        Set SBook = Workbooks.Open(Filename:=SPath)
        SBook.Worksheets(1).Range("A5").Copy
        DBook.Worksheets(1).Range("A" & SNumb).PasteSpecial Paste:=xlPasteValues
        SBook.Close SaveChanges:=False
        SFile = Dir
    Loop
    
    With Application
        .ScreenUpdating = True
        .DisplayAlerts = True
    End With
    
    'Notification that
    'macro is finished...
    
    MsgBox _
        Prompt:="Finished.", _
        Buttons:=vbInformation

End Sub