Meerdere sheets in een file samenvoegen vanuit een basis file.

[pumadennis]

Hoi,

Ik heb een basisfile macro.xlsm gemaakt. Deze wordt begin van de maand geopend. Hierin zit een knop die een file laat openen. Vervolgens moet er in die geopende file een sheet Total toegevoegd worden en daarna mag van alle sheets (3 tm 13) de data vanaf rij 5 tot zoveel er staat gekopieerd en geplakt worden in total.

onderstaande code is waar ik nu ben maar ik lijk geen stap verder te komen.

kan iemand mij helpen?

Het scherm voor openen opent. maar de macro stopt dan omdat het object niet goed is. als ik het sheetje en de laatste macro draai werken deze wel. Maar de combinatie van de 3 gaat niet.... ergens doe ik iets fout maar zie niet wat...

Sub openen()

    Workbooks.Open Filename:=Application.GetOpenFilename

    ThisWorkbook.Activate

    Call test

End Sub

Sub test()
    Sheets.Add.Name = "Total"
    Sheets("UK").Rows("1:1").Copy
    Sheets("Total").Paste
    
    Call test2
End Sub

Sub test2()

Dim j, iWS As Integer
   For iWS = 3 To 13
     For j = 2 To Sheets(iWS).Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets(2).Range("A65536").End(xlUp).Offset(1).EntireRow.Value _
 = Worksheets(iWS).Cells(j, 1).EntireRow.Value
     Next j
   Next iWS
End Sub

 

[pumadennis]

Ik heb onderstaand gemaakt van de macro die het allemaal wijzigd. ik moet het alleen nog zo zien te maken dat de macro in file A staat en dat het werk verricht moet worden in file B

Sub Samenvoegen()
    Application.ScreenUpdating = False
    
    Dim J As Integer

    On Error Resume Next
    Sheets(2).Select
    Worksheets.Add ' add a sheet in first place
    Sheets(2).Name = "Total"

    ' copy headings
    Sheets(3).Activate
    Range("A1").EntireRow.Select
    Selection.Copy Destination:=Sheets(2).Range("A1")

    ' work through sheets
    For J = 3 To Sheets.Count ' from sheet 3 to last sheet
        Sheets(J).Activate ' make the sheet active
        Range("A5").Select
        Selection.CurrentRegion.Select ' select all cells in this sheets

        ' copy cells selected in the new sheet on last line
         Selection.Copy Destination:=Sheets(2).Range("A65536").End(xlUp)(2)
    Next
    
    Sheets(2).Select
    Cells.EntireColumn.AutoFit
    Application.ScreenUpdating = True
    MsgBox "Total is ready", vbInformation
End Sub