ExcelBanter

ExcelBanter (https://www.excelbanter.com/)
-   Excel Programming (https://www.excelbanter.com/excel-programming/)
-   -   Open file, Copy a column and paste this into a new Excel doc - Pl (https://www.excelbanter.com/excel-programming/336357-open-file-copy-column-paste-into-new-excel-doc-pl.html)

Harish Mohanbabu[_2_]

Open file, Copy a column and paste this into a new Excel doc - Pl
 
Hi,

There are around 700 files in a particular directory. This directory is
mapped to my drive (F:\)

What I want to do is -

1) Open the files one by one in the above directory
2) Copy just a particular column (B4) alone in all those files
3) And paste them all into a single Excel file

These files are in XML format, but could be opened with Excel.

Can some one help me please.

Thanks,

Harish Mohanbabu
MBS Axapta - MVP
http://www.harishm.com/

Toppers

Open file, Copy a column and paste this into a new Excel doc - Pl
 
Hi,


This should get you started. It all assumes ALL files in your directory
are to be processed. Code is assumed to be in in your output file. Change wb
to refer to output workbook if this is required.

Sub CopyB4()

Dim wb As Workbook, outrng As Range, Storeb4()

Set wb = ThisWorkbook ' <=== Change if output workbook is not this one


Set fs = Application.FileSearch

Inpath = "C:\Documents and Settings\John Topley\My Documents\Test Files\" '
<=== Change

With fs
Filescount = 0

.LookIn = Inpath
.Filename = "*.xls"
.Execute

If .FoundFiles.Count 0 Then
nf = .FoundFiles.Count
ReDim Storeb4(1 To 1, 1 To .FoundFiles.Count) ' assumes all files
to be processed
For i = 1 To .FoundFiles.Count
Workbooks.Open .FoundFiles(i)
Storeb4(1, i) = Range("B4") ' Store B$ data
Workbooks(FileNameOnly(.FoundFiles(i))).Close SaveChanges:=False
Next i

End If
End With
' Write date to ouput file
wb.Worksheets("Sheet1").Range("a1:a" & nf) =
Application.Transpose(Storeb4)

End Sub
Function FileNameOnly(pname) As String
' Returns the filename from a path/filename string
Dim i As Integer, length As Integer, temp As String
length = Len(pname)
temp = ""
For i = length To 1 Step -1
If Mid(pname, i, 1) = Application.PathSeparator Then
FileNameOnly = temp
Exit Function
End If
temp = Mid(pname, i, 1) & temp
Next i
FileNameOnly = pname
End Function


HTH

"Harish Mohanbabu" wrote:

Hi,

There are around 700 files in a particular directory. This directory is
mapped to my drive (F:\)

What I want to do is -

1) Open the files one by one in the above directory
2) Copy just a particular column (B4) alone in all those files
3) And paste them all into a single Excel file

These files are in XML format, but could be opened with Excel.

Can some one help me please.

Thanks,

Harish Mohanbabu
MBS Axapta - MVP
http://www.harishm.com/



All times are GMT +1. The time now is 08:41 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
ExcelBanter.com