Error 1004/400: methode select van klasse range

[Clemiente]

Ik wil met deze macro meerdere bestanden in een worksheet plaatsen maar ik ga onderuit op de .select, kan iemand mij met deze uitdaging helpen?

Sub Samenvoegen()
Dim wbDst As Workbook
Dim wbSrc As Workbook
Dim wsSrc As Worksheet
Dim MyPath As String
Dim strFilename As String
Dim wbStart As Integer
Dim wbEind As Integer
On Error GoTo Errorcatch


Application.DisplayAlerts = False
Application.EnableEvents = False
Application.ScreenUpdating = False
MyPath = "\\domain1.local\Desktop\lijsten" ' change to suit
Set wbDst = Workbooks.Add(xlWBATWorksheet)
Set wsDst = wbDst.Worksheets.Add
wsDst.Activate
strFilename = Dir(MyPath & "\*.xlsx", vbNormal)

If Len(strFilename) = 0 Then Exit Sub

Do Until strFilename = ""

Set wbSrc = Workbooks.Open(Filename:=MyPath & "\" & strFilename)
Set wsSrc = wbSrc.Worksheets(1)

Set rngMaster = wsDst.Range("A65536").End(xlUp)

Aa = wsDst.UsedRange.Rows.Count
Bb = wsSrc.UsedRange.Rows.Count

' get all data cells
Set rngData = wsSrc.UsedRange
' copy data across
rngData.Copy rngMaster
wsDst.Activate
Range(Cells(Aa, 1), Cells(Bb + Aa, 1)).Select
Range(Cells(Aa, 1), Cells(Bb + Aa, 1)).Insert
Range(Cells(Aa, 1), Cells(Bb + Aa, 1)).Value = strFilename



wbSrc.Close False

strFilename = Dir()

Loop
wbDst.Worksheets(1).Delete

Application.DisplayAlerts = True
Application.EnableEvents = True
Application.ScreenUpdating = True

Exit Sub

Errorcatch:
MsgBox Err.Description

End Sub

Thanks alvast!

 

[Elsendoorn2134]

Cliemente,

Ik kan je foutmelding niet reconstrueren. Bij mij werkt deze macro prima.
Kan het zijn dat het bestand met de macro opnieuw geopend wordt omdat hij in dezelfde locatie
(\\domain1.local\Desktop\lijsten) staat?

Veel Succes.

 

[Clemiente]

Ik dacht even dat je de oplossing had maar helaas... Ergens staat iets fout bij mij.

Bedankt iig