macro opens the desired file and paste the information in a selected from me sheet

[k0st4din]

Hello everyone,
leading up the rules I have to say that I did ask in this forum, but so far nobody has responded and now I write here and ask if you can help me.?
I need your help because I came in a big dilemma.
Here is it:
I have 1 main excel file (database) in multiple folders have other excel files.
I am looking for a macro that puts it in a database file and pressing a button to allow me to open my desired file (excel), where it is located in my computer and copy the information from it and put it after the last busy order (ie accumulation of information). Another very important thing: when I open the desired files - macro should I copy from cell A2: F, then in column W2: to the last saved order to put the information in column G, then continue from H2: L. .. ...
In the following selected me file these records should continue from the last saved row down and so on.
There's something else in my main file (database) have 15 sheets after I chose which file I want to open it, somehow I want to ask me and I can choose which of these sheets to store the information.
I hope you can help me. I'll attach a few examples to test....
Link to download

[k0st4din]

Can anyone help me because I really need this macro, I have over 80 files that if I had to process until now, will shoot straight?

[westconn1]

but so far nobody has responded

this maybe because it is hard to understand what you want to do

I have over 80 files

you want to click button for each file? or click button once to do all files?
you want user to select files or just process all files in a location?
you want the user to select destination sheet for each of 80 files?

macro should I copy from cell A2: F, then in column W2: to the last saved order to put the information

please explain more clearly, which cells you want to copy

[k0st4din]

Hello I will try to explain again, maybe not really understand it.
I excel file "database" on my desktop I have a folder named companies supply and in this folder I have 400 excel files, each one with a specific name.
I want (and I did it as an example) when I open my excel file "database" with a macro button pressed him to open my window and asked me where and which file I want to copy, and then his state in which sheet and pastes the information it accumulates.
you want to click button for each file? - Yes
you want user to select files or just process all files in a location?
I want when I'm chosen excel file I tell him in the sheet that bring it to the file "database"
you want the user to select destination sheet for each of 80 files?
Yes because when we read files know which file exactly where (which sheets) to save it. But the problem is that we can not do it automatically, because everyone is different and therefore we have to decide in what sheet to save it.
If you download the examples I've provided, you will realize what I want to happen.
Thank you in advance
7043928R.jpg

[westconn1]

you can try like

Sub Button1_Click()
f = Application.FindFile
If Not f Then Exit Sub  ' no file selected
Set sht = ActiveWorkbook.Sheets(1)
For Each ws In ThisWorkbook.Worksheets
    If Not ws.Name = "Sheet1" Then UserForm1.ListBox1.AddItem ws.Name
Next
UserForm1.Caption = "Select sheet from list"

UserForm1.Show
Set ws = ThisWorkbook.Sheets(UserForm1.ListBox1.Text)
rwcnt = sht.UsedRange.Rows.Count - 1
ws.Range("a2").Resize(rwcnt, 6).Value = sht.Range("a2").Resize(rwcnt, 6).Value
ws.Range("h2").Resize(rwcnt, 6).Value = sht.Range("g2").Resize(rwcnt, 6).Value
ws.Range("g2").Resize(rwcnt).Value = sht.Range("w2").Resize(rwcnt).Value

End Sub

alternatively you can use application.getopenfilename to select file or mutilple files, and make the code into a loop to process each file in turn
this always copies to the same row on sheet (assumes empty sheet, else clearcontents first), if you want to add at end of previous data, change A2 to dynamic first empty row
i used a userform with a listbox to select the worksheet, code below

Private Sub ListBox1_Click()
Me.Hide
End Sub

[k0st4din]

Hello,
I put The made code ( macro ) , but when I pressed the button and my window pops up to choose which file to Extract it to me , he did not do it and I open it and I have already two files (ie database and selected file). Secondly I see that it was written to have a form of usage , but I do not know how to do.
Would it be possible to do so :
"database " I constantly open the file , go into my folders and find the file , open it , and then clicks on the file " database" and press the button when he get his information from other open my file ( as before asking me in what sheet to save it ) .
I beg you - help me, cause I'm not very aware of the matter and if necessary to make such a userform , you made ​​some ( I do not claim what it looks like ) . Even if you make it in the test file I attach, then I will change the names of the sheets.
There's more, when I try to open a second store in the same file selected sheet, I do not accumulate information and deletes the front and put the new should not be so, but to put it on the next free line
http://prikachi.com/images/758/7046758d.jpg
http://prikachi.com/images/756/7046756U.jpg
http://prikachi.com/images/761/7046761W.jpg
Infinite thank you very much.

[westconn1]

your userform looks perfectly fine

There's more, when I try to open a second store in the same file selected sheet, I do not accumulate information and deletes the front and put the new should not be so, but to put it on the next free line

now fixed to add below existing

Sub Button1_Click()
    f = Application.FindFile
    If Not f Then Exit Sub ' no file selected
    Set sht = ActiveWorkbook.Sheets(1)
    useform1.listbox1.clear
    For Each ws In ThisWorkbook.Worksheets
        If Not ws.Name = "Sheet1" Then UserForm1.ListBox1.AddItem ws.Name
    Next
    UserForm1.Caption = "Select sheet from list"
     
    UserForm1.Show
    Set ws = ThisWorkbook.Sheets(UserForm1.ListBox1.Text)
    rwcnt = sht.UsedRange.Rows.Count - 1
    nexrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
    ws.Range("a" & nexrow).Resize(rwcnt, 6).Value = sht.Range("a2").Resize(rwcnt, 6).Value
    ws.Range("h" & nexrow).Resize(rwcnt, 6).Value = sht.Range("g2").Resize(rwcnt, 6).Value
    ws.Range("g" & nexrow).Resize(rwcnt).Value = sht.Range("w2").Resize(rwcnt).Value
End Sub

but when I pressed the button and my window pops up to choose which file to Extract it to me , he did not do it and I open it and I have already two files (ie database and selected file).

i am not sure i understand what you are telling me here
if the other file(s) is already open, you can use the same userform to select the file, replace the first 3 lines above with

userform1.listbox1.clear
for each wb in workbooks
     if not wb.name = "database.xls" then userform1.listbox1.additem wb.name
next
userform1.caption = "Select workbook to import to database"
set sht = workbooks(userform1.listbox1.text).sheets(1)

[k0st4din]

Please look at the pictures.
And at first and second macro (that thing with replacement) gives me an error of certain lines. Everything I've shot.
Thank infinite
http://prikachi.com/images/349/7048349x.jpg -
http://prikachi.com/images/350/7048350X.jpg - your first macro
http://prikachi.com/images/351/7048351n.jpg - in addition to or in substitution to the right of the first 3 lines

[k0st4din]

I found where the problem is. Additions'm in another macro that is not about action.
My fault.
Thank you.
Hello westconn1
this macro works incredibly well, and I am very pleased with it, thanks to your help.
I appreciate very making of the macro.
In the excel file that I use I have to add a few more columns to be copied and placed in desired me other columns.
In this line of thinking and logically decided to Complete the (added) new desired columns thus shown in the macro (I showed the new desired columns with quotes), but macros are without it.
And when I trigger it macro, it continues to copy only the old stuff.
I wonder where dabble in the macro, only I have added a few more columns.
I'll be grateful if you help me.
Be safe and sound.

Sub Button2_Click()    
f = Application.FindFile
    If Not f Then Exit Sub ' no file selected
    Set sht = ActiveWorkbook.Sheets(1)
    UserForm1.ListBox1.Clear
    For Each ws In ThisWorkbook.Worksheets
        If Not ws.Name = "Sheet1" Then UserForm1.ListBox1.AddItem ws.Name
    Next
    UserForm1.Caption = "Select sheet from list"
     
    UserForm1.Show
    Set ws = ThisWorkbook.Sheets(UserForm1.ListBox1.Text)
    rwcnt = sht.UsedRange.Rows.Count - 1
    nexrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
    ws.Range("a" & nexrow).Resize(rwcnt, 6).Value = sht.Range("a2").Resize(rwcnt, 6).Value
    ws.Range("h" & nexrow).Resize(rwcnt, 6).Value = sht.Range("g2").Resize(rwcnt, 6).Value
    ws.Range("g" & nexrow).Resize(rwcnt).Value = sht.Range("w2").Resize(rwcnt).Value '-> This selects the a specific column and places it in another specific column
    'ws.Range("y" & nexrow).Resize(rwcnt).Value = sht.Range("n2").Resize(rwcnt).Value '-> but here and does not want to do it
    'ws.Range("z" & nexrow).Resize(rwcnt).Value = sht.Range("p2").Resize(rwcnt).Value ' same
    'ws.Range("AA" & nexrow).Resize(rwcnt).Value = sht.Range("R2").Resize(rwcnt).Value 'same
    'ws.Range("AB" & nexrow).Resize(rwcnt).Value = sht.Range("T2").Resize(rwcnt).Value 'same
    'ws.Range("AC" & nexrow).Resize(rwcnt).Value = sht.Range("V2").Resize(rwcnt).Value 'same
End Sub

[westconn1]

post a workbook with some sample data and the code that is not working correctly

[k0st4din]

In the above post I mentioned that I have found the problem.
Everything works as it should be.
Thank you very much

[k0st4din]

Hello westconn1
a long time working with this macro written by you and it works very well. Thank you very much. But I have one question - recently changed office suite 2007 of higher 2010, 2013 and macro gives me an error at the outset (I will show you where).
My question is: Anything else you need to write in order to open the window and navigate to the files?
Thank you very much.

Sub Button1_Click() 
    f = Application.FindFile '-------->>>> here gives me error in office 2010 and 2013
    If Not f Then Exit Sub 
    Set sht = ActiveWorkbook.Sheets(1) 
    useform1.listbox1.clear 
    For Each ws In ThisWorkbook.Worksheets 
        If Not ws.Name = "Sheet1" Then UserForm1.ListBox1.AddItem ws.Name 
    Next 
    UserForm1.Caption = "Select sheet from list" 
     
    UserForm1.Show 
    Set ws = ThisWorkbook.Sheets(UserForm1.ListBox1.Text) 
    rwcnt = sht.UsedRange.Rows.Count - 1 
    nexrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1 
    ws.Range("a" & nexrow).Resize(rwcnt, 6).Value = sht.Range("a2").Resize(rwcnt, 6).Value 
    ws.Range("h" & nexrow).Resize(rwcnt, 6).Value = sht.Range("g2").Resize(rwcnt, 6).Value 
    ws.Range("g" & nexrow).Resize(rwcnt).Value = sht.Range("w2").Resize(rwcnt).Value 
End Sub

[k0st4din]

Hello, everyone,
this macro which is made so long ago I do a lot of work, but when I change computers of some of them has a higher version of the office suite 2010, 2013 and there when i open the table gives me an error that can not find a library .
it comes to this line at the outset:

'f = Application.Findfile

In the new version of the office suite anything else need to write in order to work?
Another Is command in the macro itself to trigger it?
Thank you in advance

[mancubus]

FindFile method works in MSO2013. (and i believe in 2007, 2010, 2016 which i can't test at the moment)

alternatively you can use;

Sub Button1_Click()
    
    Dim FileToOpen As String
    
    FileToOpen = Application.GetOpenFilename("Excel Files *.xls* (*.xls*),")
    If FileToOpen = False Then Exit Sub
    Workbooks.Open Filename:=FileToOpen
    
    Set sht = ActiveWorkbook.Sheets(1)
    ...
    ...
    ...

End Sub

[k0st4din]

Hello mancubus
I deeply believe that should work, but several times I meet this problem and it mostly office 2010, pushing its button and track where the mistake I marked this line that I've shown and I said: "Can not to find a file path or library!"
As soon as I go to those computers that have this office will open my file and will try and proposed version of you.
Actually I have no idea why is this problem.
Thank you warmly.
I'll write necessarily the result.
P.S. Immediately it out on my Office 2007 and gave me the error:
Showing the entire macro: somewhere something stops him:
2017-04-12_185250.jpg