Ron,
Thanks for getting back to me.
Like I said I am very new to
VB and I do struggle to understand some of code.
I looked at the example of codes that you gave me the link to and what I've
tried to do is take the line that copies the rows of data and import into the
macro that I was using because I really needed the code to look for specific
file names and also to copy the header from the first file it extracts and
ignore the rest. The problem I have is that it only copies the header and not
the data.
From the code below could you perhaps give me a little guidance as to where
I am going wrong.
Sub Copy_From_Multiple_P14_Files()
Dim Lrow As Long
Dim Hdrs As Long
Dim NumCols As Long
Dim ffc As Long
Dim i As Long
Dim R As Integer
Dim WBn As String
Dim rng As Range
Dim WB As Workbook
Dim WBr As Range
Dim WBlstrw As Long
Dim CurWkb As Workbook
Dim CurWks As Worksheet
Dim CurWksLrow As Long
Dim strStartDir As String
Dim UserFile As String
Dim Sht As Worksheet
Dim sh As Worksheet
Dim DestSh As Worksheet
Dim shLast As Long
Dim Last As Long
On Error Resume Next
Set CurWkb = Workbooks.Add
Set CurWks = CurWkb.Worksheets(1)
Application.ScreenUpdating = False
With CurWks
.Activate
.UsedRange.Delete
End With
Lrow = 1
Hdrs = 1
With Application.FileSearch
.SearchSubFolders = True
.NewSearch
.Filename = "PAck*.csv"
.LookIn = UserFile
.FileType = msoFileTypeExcelWorkbooks
.Execute
ffc = .FoundFiles.Count
For i = 1 To ffc
Set WB = Application.Workbooks.Open(Filename:=.FoundFiles(i ))
If i = 1 Then
NumCols = WB.Sheets(1).UsedRange.Column - 1 + _
WB.Sheets(1).UsedRange.Columns.Count
CurWks.Cells(Hdrs, "A").Resize(1, NumCols).Value = _
WB.Worksheets(1).Range("A1").Resize(1, NumCols).Value
End If
Application.StatusBar = "Currently Processing file " & i & " of
" & ffc
sh.Range(sh.Rows(3), sh.Rows(shLast)).Copy DestSh.Cells(Last +
1, "A")
CurWks.Cells(Lrow + 1, "A").Resize(WBlstrw - Hdrs,
NumCols).Value = _
WB.Worksheets(1).Range("A2").Resize(WBlstrw - Hdrs, NumCols).Value
Lrow = Lrow + (WBlstrw - Hdrs)
WB.Close savechanges:=False
Next
End With
Set WB = Nothing
Set CurWks = Nothing
Set CurWkb = Nothing
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub
Any help would be gratefully appreciated.
many thanks and kind regards
Chris
"Ron de Bruin" wrote:
You can find a example here that use a function to find the last row
http://www.rondebruin.nl/copy3.htm
--
Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm
"ir26121973" wrote in message ...
Hi,
Wonder if someone acn help me please.
I am using, and have been for sometime some great coding below, (admitedly
not mine, a great programmer called Ken Wright) to copy rows of data from
multiple workbooks and pasting them into one master sheet. The macro also
copies the header of the first workbook it extracts the data from and ignores
the headers in the rest.
Sub CopyFromMultipleFiles()
Dim lrow As Long
Dim Hdrs As Long
Dim NumCols As Long
Dim ffc As Long
Dim i As Long
Dim R As Integer
Dim WBn As String
Dim rng As Range
Dim WB As Workbook
Dim WBr As Range
Dim WBlstrw As Long
Dim CurWkb As Workbook
Dim CurWks As Worksheet
Dim CurWksLrow As Long
Dim strStartDir As String
Dim UserFile As String
Dim Sht As Worksheet
On Error Resume Next
UserFile = PickFolder(strStartDir)
If UserFile = "" Then
MsgBox "Canceled"
Exit Sub
End If
Set CurWkb = Workbooks.Add
'CurWks will always refer to the Summary worksheet you are creating
Set CurWks = CurWkb.Worksheets(1)
Application.ScreenUpdating = False
'Clear out the Summary worksheet
With CurWks
.Activate
.UsedRange.Delete
End With
lrow = 1
Hdrs = 1
With Application.FileSearch
.SearchSubFolders = True
.NewSearch
.Filename = ".xls"
.LookIn = UserFile
.FileType = msoFileTypeExcelWorkbooks
.Execute
ffc = .FoundFiles.Count
For i = 1 To ffc
'WB will always refer to the source Workbook that
'you are interrogating at the time
Set WB = Application.Workbooks.Open(Filename:=.FoundFiles(i ))
If i = 1 Then
NumCols = WB.Sheets(1).UsedRange.Column - 1 + _
WB.Sheets(1).UsedRange.Columns.Count
CurWks.Cells(Hdrs, "A").Resize(1, NumCols).Value = _
WB.Worksheets(1).Range("A1").Resize(1, NumCols).Value
End If
Application.StatusBar = "Currently Processing file " & i & " of
" & ffc
WBn = WB.Name
WBlstrw = WB.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row
'Copy the data across
CurWks.Cells(lrow + 1, "A").Resize(WBlstrw - Hdrs,
NumCols).Value = _
WB.Worksheets(1).Range("A2").Resize(WBlstrw - Hdrs,
NumCols).Value
' 'Put the filename in the first Col as an index value
' CurWks.Cells(lrow + 1, "A").Resize(WBlstrw - Hdrs, 1).Value =
WBn
lrow = lrow + (WBlstrw - Hdrs)
WB.Close savechanges:=False
Next
End With
Set WB = Nothing
Set CurWks = Nothing
Set CurWkb = Nothing
Application.ScreenUpdating = True
Application.StatusBar = False
End Sub
The problem I have is that the files I get containing the data I extract
have changed. The above macro assumes that there is always data in the A
column and uses this as a guide to copy the data within the whole row. This
is now not always the case.
With my very limited VB knowledge, by changing things around, adding and
removing the code I think I've located the line that needs to change as this:
'WBlstrw = WB.Sheets(1).Cells(Rows.Count, "A").End(xlUp).Row'
I am fairly new to VB and not that confident and I've tried to change the
Cells(Row to Range, but this doesn't work.
Could somebody tell me please how I could change the code so it looks at a
range rather than column A.
Many thanks and regards
Chris