Locate excel file, then extract columns, paste special values into a named sheet / tab

[Pup Denab]

HI Everyone
I hope one of you can help me with this,
I need to copy columns A-P, then paste special (values only) into another sheet, my problem is the sheet where its going is named however the sheet where it comes from is a system generated name, which is alpha numeric (and not open), the only constant is where it is saved, as this is automatic extracted, into a certain folder, is it possible to collect the data from the newest excel sheet in a folder ?


From
C:\Documents and Settings\All Users\Desktop\updatenov\anyname

To
C:\Documents and Settings\All Users\Desktop\matrix.xlsm\rawdata

I'm looking for vba solution to automate the process

any help would be welcome
Thanks

 

[JoeMo]

This is untested and may need some tweaking, At a minimum you must insert the correct file and sheet names where appropriate.

Sub PupDenab()
Const destWb As String = "C:\Documents and Settings\All Users\Desktop\matrix.xlsm"
Dim pStr As String, myFile As String, LastSav As Variant, fNam As String
pStr = "C:\Documents and Settings\All Users\Desktop\updatenov\"
myFile = Dir(pStr & "*.xls?")
If myFile = vbNullString Then
    Exit Sub
Else
    LastSav = FileDateTime(pStr & myFile)
    fNam = myFile
End If
Do
    myFile = Dir()
    If myFile = vbNullString Then Exit Do 'No files left in folder
    If FileDateTime(pStr & myFile) > LastSav Then fNam = myFile
Loop
If Not WorkBookOpen(fNam) Then
Workbooks.Open pStr & fNam
End If
Workbooks(fNam).Sheets("Sheet1").Columns("A:P").Copy
Workbooks(destWb).Sheets("rawdata").Range("A1").PasteSpecial Paste:=xlValues
End Sub

Function WorkBookOpen(book As String)
Dim wbName As String
On Error GoTo notOpen
wbName = Workbooks(book).Name
WorkBookOpen = True
Exit Function
notOpen:
WorkBookOpen = False
End Function

 

[Pup Denab]

Thanks Joe, I'll have a play around with it

 

[Pup Denab]

HI Joe
I'm getting, error 9, out of script, but only when it get to the paste part

Workbooks(destWb).Sheets("rawdata").Range("A1").PasteSpecial Paste:=xlValues

Const destWb As String = "C:\Documents and Settings\All Users\Desktop\matrix.xlsm"
Sheet1

I'll assume it me, , can you define the location of the file "C\New Microsoft Office Excel Worksheet.xlsx"
I can sort of follow what you have done, but I'm no vba guy, in any sense of the word,
I have tried to do this myself but I'm sure you can do it in about 10 seconds

Thank you again, you code is very helpful indeed

 

[JoeMo]

HI Joe
I'm getting, error 9, out of script, but only when it get to the paste part

Workbooks(destWb).Sheets("rawdata").Range("A1").PasteSpecial Paste:=xlValues

Const destWb As String = "C:\Documents and Settings\All Users\Desktop\matrix.xlsm"
Sheet1

I'll assume it me, , can you define the location of the file "C\New Microsoft Office Excel Worksheet.xlsx"
I can sort of follow what you have done, but I'm no vba guy, in any sense of the word,
I have tried to do this myself but I'm sure you can do it in about 10 seconds

Thank you again, you code is very helpful indeed

What is the name of the workbook you want to paste to and what is the name of the sheet you want to paste to? Is the paste to workbook open when you run the code?

 

[Pup Denab]

HI Joe
Yes i put your code in a module of the paste to book, and run from their, it opens the paste from book, copies the data, then the error occurs, (it looks like it can't find the paste to book) if its easier you can point it at a folder, that would only contain that file wbtest, you can name the folder fltest.
Thanks again

workbook name
wbtest

sheet name
shtest

 

[JoeMo]

HI Joe
Yes i put your code in a module of the paste to book, and run from their, it opens the paste from book, copies the data, then the error occurs, (it looks like it can't find the paste to book) if its easier you can point it at a folder, that would only contain that file wbtest, you can name the folder fltest.
Thanks again

workbook name
wbtest

sheet name
shtest

It can't find the paste book because the path/name you used in your initial post was different than what you have just provided above. As I said in my first post, you have to insert the correct file and sheet names! It's always a good idea to provide that type of information in your initial post if you are requesting code to be written.
Try this:

Sub PupDenab()
Const destWb As String = "wbtest.xlsm" 'Change to suit
Dim pStr As String, myFile As String, LastSav As Variant, fNam As String
pStr = "C:\Documents and Settings\All Users\Desktop\updatenov\"
myFile = Dir(pStr & "*.xls?")
If myFile = vbNullString Then
    Exit Sub
Else
    LastSav = FileDateTime(pStr & myFile)
    fNam = myFile
End If
Do
    myFile = Dir()
    If myFile = vbNullString Then Exit Do 'No files left in folder
    If FileDateTime(pStr & myFile) > LastSav Then fNam = myFile
Loop
If Not WorkBookOpen(fNam) Then
Workbooks.Open pStr & fNam
End If
Workbooks(fNam).Sheets("Sheet1").Columns("A:P").Copy
Workbooks(destWb).Sheets("shtest").Range("A1").PasteSpecial Paste:=xlValues
End Sub

Function WorkBookOpen(book As String)
Dim wbName As String
On Error GoTo notOpen
wbName = Workbooks(book).Name
WorkBookOpen = True
Exit Function
notOpen:
WorkBookOpen = False
End Function

 

[Pup Denab]

H Joe
Fantastic, thank you for your help, it all works now

 

[JoeMo]

H Joe
Fantastic, thank you for your help, it all works now

You are welcome, but please replace the code you are using with the slightly modified version below which covers a subtle possible contingency.

Sub PupDenab()
Const destWb As String = "wbtest.xlsm" 'Change to suit
Dim pStr As String, myFile As String, LastSav As Variant, fNam As String
pStr = "C:\Documents and Settings\All Users\Desktop\updatenov\"
myFile = Dir(pStr & "*.xls?")
If myFile = vbNullString Then
    Exit Sub
Else
    LastSav = FileDateTime(pStr & myFile)
    fNam = myFile
End If
Do
    myFile = Dir()
    If myFile = vbNullString Then Exit Do 'No files left in folder
    If FileDateTime(pStr & myFile) > LastSav Then
        LastSav = FileDateTime(pStr & myFile)
        fNam = myFile
    End If
Loop
If Not WorkBookOpen(fNam) Then
Workbooks.Open pStr & fNam
End If
Workbooks(fNam).Sheets("Sheet1").Columns("A:P").Copy
Workbooks(destWb).Sheets("shtest").Range("A1").PasteSpecial Paste:=xlValues
End Sub

Function WorkBookOpen(book As String)
Dim wbName As String
On Error GoTo notOpen
wbName = Workbooks(book).Name
WorkBookOpen = True
Exit Function
notOpen:
WorkBookOpen = False
End Function

 

[Dedonovan]

This is a great code and very close for the application I am working with. How would you incorporate sub folders into this code? I have 5 sub folders all contained within a parent folder that I would like to copy the same range off each worksheet and paste to a master file. I have modified my test to use the code above but don't know how to incorporate different sub folders. Thanks in advance for any help!
-David