Hi forumleden,
Middels de volgende code voeg ik diverse Excel bestanden tot 1 compleet.
Echter krijg ik tijdens het toevoegen van data en het openen van de diverse .xlsx bestanden iedere keer bij het openen van ieder bestand de vraag om externe koppelingen bij te werken.
Is er een mogelijkheid om deze in de macro te verwerken om te kiezen voor NIET BIJWERKEN.
Verder wordt er ook een enkele keer gevraagd om een bepaalde waarde uit een ander bestand te halen. Ook deze melding wil ik graag skippen zodat hij netjes doorloopt.
Alvast bedankt.
Middels de volgende code voeg ik diverse Excel bestanden tot 1 compleet.
Code:
Sub VoegExcelBestandenSamenIn1NieuwBlad()
' [TOPIC=848630///][NOHTML][rml][ Excel] Meerdere bestanden samenvoegen[/rml][/NOHTML][/TOPIC]
' deel 2
Dim wbSingleWorkbook As Excel.Workbook, wbFinalWorkbook As Excel.Workbook
Dim wsSingleSheet As Excel.Worksheet, wsFinalSheet As Excel.Worksheet
Dim strPath As String, strWorkbook(500) As String ' max 500 bestanden
Dim intCounter As Integer, n As Integer
Dim Answer As VbMsgBoxResult
strPath = "c:\test\" ' Map met .xlsx-bestanden
intCounter = 1 ' teller
strWorkbook(intCounter) = Dir(strPath & "*.xlsx")
Do While strWorkbook(intCounter) <> ""
intCounter = intCounter + 1
strWorkbook(intCounter) = Dir
Loop
intCounter = intCounter - 1 ' want de laatste is leeg
Set wbFinalWorkbook = Workbooks.Add
Application.DisplayAlerts = False
Do While wbFinalWorkbook.Sheets.Count > 1
wbFinalWorkbook.Sheets(1).Delete
Loop ' We hebben maar 1 blad nodig
Application.DisplayAlerts = True
Set wsFinalSheet = wbFinalWorkbook.Sheets(1)
On Error GoTo Einde ' Error trapping AAN
For n = 1 To intCounter
Set wbSingleWorkbook = Workbooks.Open(Filename:=strPath _
& strWorkbook(n), ReadOnly:=True)
For Each wsSingleSheet In wbSingleWorkbook.Sheets
wsSingleSheet.UsedRange.Copy _
Destination:=wsFinalSheet.Cells _
(wsFinalSheet.Cells.SpecialCells _
(xlCellTypeLastCell).Row + 1, 1)
Next wsSingleSheet
wbSingleWorkbook.Close
Next n
On Error GoTo 0 ' Error trapping UIT
Einde:
Select Case Err.Number ' Foutmelding 1004 is
' hoogstwaarschijnlijk veroorzaakt
Case 1004 ' door iets te plakken dat boven
' de 65536 rijen uit zou komen
Answer = MsgBox(Err.Description & Chr(13) & Chr(13) & _
"Waarschijnlijk wordt dit bestand te groot..." & _
Chr(13) & "Verder gaan op nieuw blad?", _
vbCritical Or vbYesNo, "Error " & Err.Number & _
": " & Err.Description)
If Answer = vbYes Then
Set wsFinalSheet = wbFinalWorkbook.Sheets.Add
Resume
End If
Case 0 ' Niks aan 't handje :-)
Case Else ' Overige foutmeldingen
MsgBox Err.Description, _
vbCritical Or vbOKOnly, "Error " & Err.Number & _
" in bestand " & n
End Select
Set wbSingleWorkbook = Nothing
Set wbFinalWorkbook = Nothing
Set wsSingleSheet = Nothing
Set wsFinalSheet = Nothing
End SubEchter krijg ik tijdens het toevoegen van data en het openen van de diverse .xlsx bestanden iedere keer bij het openen van ieder bestand de vraag om externe koppelingen bij te werken.
Is er een mogelijkheid om deze in de macro te verwerken om te kiezen voor NIET BIJWERKEN.
Verder wordt er ook een enkele keer gevraagd om een bepaalde waarde uit een ander bestand te halen. Ook deze melding wil ik graag skippen zodat hij netjes doorloopt.
Alvast bedankt.
Ik neem aan dat je a. hebt ingevoerd in je VBA code en dat dat precies doet wat je vroeg.
) van mijn code in a. van posting #2 is puur tijdens het openen. Er verandert niets in het bestand zelf en ook niet in de manier waarop je (een volgende keer) het bestand interactief of via macro opent, qua UpdateLinks activiteit.
