Deel van werkbladen kopieren en samenvoegen

[Feijtert]

Hallo,

Ik ben wat aan het stoeien geweest met macro's, maar ik kom er helaas niet uit. Ik wil graag het volgende realiseren:

Er zijn 15 verschillende bestanden (in dit voorbeeld zijn dit er 2, namelijk 'bestand1' en 'bestand2') met ieder 1 sheet. In ieder bestand staan in kolom A de magazijnen weergegeven. Nu is het de bedoeling dat middels een macro de gegevens per bestand en per magazijn worden overgeschreven naar de activeworkbook (in dit voorbeeld het bestand 'Totaal Breda'). Uiteindelijk moet er dus per magazijn een bestand worden aangemaakt met daarin 15 tabbladen. Als het even kan zouden de tabbladen de namen mogen krijgen van het bestand waaruit de betreffende gegevens zijn opgehaald.

Ik hoop dat dit alles mogelijk is.

mvg,

Arjen

 

[Guus2005]

Tsjonge. Zou je niet beter overstappen naar Access??
Daarin lees je al die bestanden in tabellen en je voegt ze samen. Daarna kan je iedere willekeurige rapportage draaien.

Het is maar een hint.

Enjoy!

 

[Feijtert]

Guus, daar heb je wel een punt. Ik heb dat ook overwogen, maar aangezien mijn kennis mbt access beperkt is, wilde ik het eerst in excel proberen. Maar ik zal me eens wat meer in access verdiepen. Bedankt!

 

[Feijtert]

Ik ben het toch in Excel aan het proberen. Ik loop echter vast op de functie 'replace'. Ik krijg de melding 'Compileerfout' Argument is niet optioneel. Ik denk dat ik nog een stukje code toe moet voegen, ik heb geen idee waar. Heeft iemand een idee wat er niet klopt in deze code?

Alvast bedankt!


Sub GetDataFromClosedWorkbook()
Dim wb As Workbook
Application.ScreenUpdating = False ' turn off the screen updating
Set wb = Workbooks.Open("\\AB1FSPAR002\A9543530$\My Documents\Test voor Stephan\Nieuwe map\2.xls", True, True)
' open the source workbook, read only
With ThisWorkbook.Worksheets(1).UsedRange.Columns(1)
' read data from the source workbook

.AutoFilter 1, Replace.ThisWorkbook.Sheets(1).[i2].Text & "*", " ", "?"
.Offset(1, -2).Resize(, 5).SpecialCells(xlCellTypeVisible).Copy ThisWorkbook.Sheets(1).Range("A11")
.AutoFilter
End With
wb.Close False ' close the source workbook without saving any changes
Set wb = Nothing ' free memory
Application.ScreenUpdating = True ' turn on the screen updating
End Sub

 

[Guus2005]

Ik ben het toch in Excel aan het proberen. Ik loop echter vast op de functie 'replace'. Ik krijg de melding 'Compileerfout' Argument is niet optioneel. Ik denk dat ik nog een stukje code toe moet voegen, ik heb geen idee waar. Heeft iemand een idee wat er niet klopt in deze code?

Alvast bedankt!

Sub GetDataFromClosedWorkbook()
Dim wb As Workbook
    Application.ScreenUpdating = False ' turn off the screen updating
    [COLOR="red"]Set wb = Workbooks.Open("\\AB1FSPAR002\A9543530$\My Documents\Test voor Stephan\Nieuwe map\2.xls", True, True)[/COLOR]
    ' open the source workbook, read only
[COLOR="Darkgreen"]    With ThisWorkbook.Worksheets(1).UsedRange.Columns(1)[/COLOR]
        ' read data from the source workbook
        
        .AutoFilter 1, Replace.ThisWorkbook.Sheets(1).[i2].Text & "*", " ", "?"
        .Offset(1, -2).Resize(, 5).SpecialCells(xlCellTypeVisible).Copy ThisWorkbook.Sheets(1).Range("A11")
        .AutoFilter
    End With
        [COLOR="Red"]wb.Close False ' close the source workbook without saving any changes[/COLOR]
        Set wb = Nothing ' free memory
        Application.ScreenUpdating = True ' turn on the screen updating
End Sub

Je maakt een workbook object aan die noem je wb (rood). Verderop sluit je die weer(rood). In de tussentijd doe je er niets mee(groen). Los van de foutmelding zie ik niet waarom dit zou werken.

De replace functie van Excel zegt mij niets. Wat zegt de Help functie?

Enjoy!

 

[Feijtert]

Je hebt gelijk. Ik probeer 2 codes (zie onderstaande) die ik afzonderlijk al in gebruik had te koppelen. Mijn kennis van vba is echter niet toereikend om dit correct te doen.

Sub GetDataFromClosedWorkbook()
Dim wb As Workbook
Application.ScreenUpdating = False ' turn off the screen updating
Set wb = Workbooks.Open("\\AB1FSPAR002\A9543530$\My Documents\Test voor Stephan\Nieuwe map\2.xls", True, True)
' open the source workbook, read only
With ThisWorkbook.Worksheets(1).UsedRange.Columns(1)
' read data from the source workbook



.Range("A10").Formula = wb.Worksheets(1).Range("A10").Formula
.Range("A11").Formula = wb.Worksheets(1).Range("A11").Formula
.Range("A12").Formula = wb.Worksheets(1).Range("A12").Formula
.Range("A13").Formula = wb.Worksheets(1).Range("A13").Formula
End With
wb.Close False ' close the source workbook without saving any changes
Set wb = Nothing ' free memory
Application.ScreenUpdating = True ' turn on the screen updating
End Sub


Het tweede deel was:


Sub Opzoeken()
Sheets("Blad1").Range("A11:e1000").ClearContents
With Sheets(1).UsedRange.Columns(1)
.AutoFilter 1, Replace(Sheets("Blad1").[i2].Text & "*", " ", "?")
.Offset(1, 0).Resize(, 20).SpecialCells(xlCellTypeVisible).Copy Sheets("blad1").Range("A3")
.AutoFilter
End With
End Sub

 

[Guus2005]

In je eerste voorbeeld gebruik je

Replace.Sheet ...

In de oorspronkelijke code staat

Replace(Sheet ...

De oorspronkelijke Replace functie is inderdaad de gewone VBA Replace() functie.
Je hebt dus een tikfout én een denkfout gemaakt.

Nu kan je weer verder proberen.
HTH

 

[Feijtert]

Ruud, ik het nu de volgende code werkend gekregen. Deze code is vast niet perfect, maar hij werkt wel. De code filtert het gesloten bestand op de voorwaarde die in cel i2 staat en haalt vervolgens alle bij behorende waarden op. Ik heb geprobeerd om ipv te werken met offset, de volledige rijen vanuit het gefilterde bestand over te zetten, maar dit lukt mij helaas niet. Misschien dat iemand nog een idee heeft?


Sub GetDataFromClosedWorkbook()
Dim wb As Workbook
Application.ScreenUpdating = False ' turn off the screen updating
Set wb = Workbooks.Open("\\AB1FSPAR002\A9543530$\My Documents\Test voor Stephan\Nieuwe map\2.xls", True, True)
' open the source workbook, read only
With Workbooks("2.xls").Sheets(1).UsedRange.Columns(1)
' read data from the source workbook

.AutoFilter 1, Replace(Workbooks("test7.xls").Sheets(1).[i2].Text & "*", " ", "?")
.Offset(0, 0).Resize(, 5).SpecialCells(xlCellTypeVisible).Copy Workbooks("test7.xls").Sheets(1).Range("A11")
.AutoFilter
End With
wb.Close False ' close the source workbook without saving any changes
Set wb = Nothing ' free memory
Application.ScreenUpdating = True ' turn on the screen updating
End Sub