Home > OS >  Open multiple workbooks and copying data into one file
Open multiple workbooks and copying data into one file

Time:06-24

I currently have to write an Excel VBA Macro, that turns up to 12 different Excel files into one PivotTable. I already have some dynamic code to turn one worksheet into an Pivot-Table-Form. The end result looks a bit like this:

| Company | Model | Indicator | Value |

| Audi | A1 | AWD | 2000 |

| Mercedes | AMG GT | AWD | 2500 |

| ... | ... | ... | ... |

(Sorry, but I was not able to get the "GitHub-flavored markdown format" to work for me.)

It took me a while, but I was able to get the code working, that is doing the formating. Now I need some help with the following things:

  • I need to open the files with the original data.
  • Then these files are supposed to be formatted using my already existing code.
  • The formated data needs to be copied into a worksheet in the Excel file, frow which I am running the macro. (this file is called A_11.xlsm.)
  • Then the next file should be opened and the process should repeat, and copy the data in the same worksheet as previous, directly under the previous data that was added.

I found some code that opens the worksheets, but I do not know how I am able to integrate this into my Project.

Sub SelectFiles()

Dim varDateipfade As Variant
Dim intcount As Integer
Dim intAnzahlDateien As Integer

varDateipfade = Application.GetOpenFilename("Datei, *.xls", , "Pkw Dateien ausw�hlen", , True)
intAnzahlDateien = UBound(varDateipfade)
MsgBox intAnzahlDateien
For intcount = 1 To intAnzahlDateien
DatenAuslesen varDateipfade(intcount)

Next
End Sub

Sub DatenAuslesen(varDateipfad As Variant)

Workbooks.Open (varDateipfad)

End Sub

The code I wrote for the formatting is a bit to long to post it into her, and I don´t want to embarras my with the amount of stupidity I wrote.

But I still can tell you how I would start, just in case someone whould need the name of the Sub.

Sub Formatierung_original_Dateien()

'The formatting, that deletes, creates and moves the cells.

End Sub

I would really appreciate if someone could help me with combining the code, so that I am able to use the full potential of my code.

Kind regards, Elias

CodePudding user response:

Please, try the next updated solution:

Sub SelectOpenFiles()
 Dim varDateipfade, intCount As Integer, intAnzahlDateien As Integer

 varDateipfade = Application.GetOpenFilename(FileFilter:="Datei (*.xls), *.xls", MultiSelect:=True, Title:="Please, select the workbooks to be processed")

 If Not IsArray(varDateipfade) Then MsgBox "Nothing Selected...", vbInformation, "Abort": Exit Sub 'for the case of no any selection...
 intAnzahlDateien = UBound(varDateipfade)

 For intCount = 1 To intAnzahlDateien 'you need to iterate between the returned aray elements
     DatenAuslesen CStr(varDateipfade(intCount)) 'send the workbook full name as parameter...
 Next
End Sub

Sub DatenAuslesen(varDateipfad As String)
   Dim wb As Workbook
   
   Set wb = Workbooks.Open(varDateipfad)
    Debug.Print wb.Sheets.count: Stop
    'do whatever you need with the workbook...
End Sub
  • Related