Kolommen naar een nieuwe werkmap kopieren

VPE · 25 jul 2013

Beste forum gebruikers

Ik zit met het volgende probleem.

Door middel van een query wordt een bronbestand gemaakt die alle gegevens bevat, waarop een aantal filters en formules worden toegepast om de nodige informatie te verkrijgen.
Omdat deze gegevens naar klanten worden opgestuurd moet dit in een sjabloon komen. Hier ligt echter mijn probleem.

Wanneer ik de juiste kolommen via volgende formule ='M:\PRIJSLIJSTEN\Werkbladen Prijslijsten\[Automatische prijslijst.xlsx]FG woodconnectors geg'!B:B
In het juiste bestand plaats worden de gefilterde cellen terug zichtbaar.
Is er een oplossing zodat deze cellen niet mee gekopieerd worden?

Het bronbestand wordt continu bijgewerkt dus eenvoudig kopiëren en plakken is geen optie.

Ik heb wee bijlagen bijgevoegd die een deel van de informatie bevatten. Het eindblad moet de finale versie voorstellen en uit de automatische prijslijst moeten de gegeven gehaald worden.
U kan zien dat de kolom met EAN codes niet meer gelijk zijn doordat de verborgen rijen er terug tussen staan.

Alvast bedank voor de inspanning

Vincent

Elsendoorn2134 · 29 jul 2013

Vincent,

Wat jij wil kan wel maar dan moet je de kolommen die je wil gebruiken apart kopieren.
Dus eerst kolom B, dan kolom C etc. Eventueel kun je gebruik maken van een VBA programmatje om je hierbij te helpen
Zet in 1Eindblad prijslijsen.xlsx de volgende macro:

Code:

Public Sub HaalGegevensOp()

Dim DoelBest As String

DoelBest = "1Eindblad Prijslijsten.xlsm"

Workbooks("1Automatische prijslijst.xlsx").Activate

'Kopieer kolommen.
Range("B2:" & Range("B2").End(xlDown).Address).Copy
Workbooks(DoelBest).Sheets("FG woodconnectors").Range("A2").PasteSpecial xlPasteValues
Range("C2:" & Range("C2").End(xlDown).Address).Copy
Workbooks(DoelBest).Sheets("FG woodconnectors").Range("B2").PasteSpecial xlPasteValues
Range("D2:" & Range("D2").End(xlDown).Address).Copy
Workbooks(DoelBest).Sheets("FG woodconnectors").Range("C2").PasteSpecial xlPasteValues
Range("X2:" & Range("X2").End(xlDown).Address).Copy
Workbooks(DoelBest).Sheets("FG woodconnectors").Range("D2").PasteSpecial xlPasteValues
Range("V2:" & Range("V2").End(xlDown).Address).Copy
Workbooks(DoelBest).Sheets("FG woodconnectors").Range("E2").PasteSpecial xlPasteValues
Range("J2:" & Range("J2").End(xlDown).Address).Copy
Workbooks(DoelBest).Sheets("FG woodconnectors").Range("F2").PasteSpecial xlPasteValues
Range("N2:" & Range("N2").End(xlDown).Address).Copy
Workbooks(DoelBest).Sheets("FG woodconnectors").Range("G2").PasteSpecial xlPasteValues

Workbooks(Doelbest).Activate


End Sub

Veel Succes.

VPE · 30 jul 2013

Elsendoorn2134,

Bedankt voor de hulp ik test vanavond eens U methode uit.
Ondertussen had ik zelf ook al wat met de macro's zitten testen en was tot een redelijke oplossing gekomen.
Nu ondervond ik wel nog een opmerkelijke fout waarbij ik voor een raadsel sta.

Wanneer ik de macro laat lopen via de ontwikkelaars tab en vervolgens via macro's uitvoeren wordt niet de volledige macro uitgevoerd. Indien ik de macro laat lopen via visual basic en vervolgens via F5 of de play knop dan wordt de volledige macro wel uitgevoerd.

Wordt er ergens een onderscheid gemaakt tussen de twee manieren van uitvoeren?
Het probleem speelt hem af bij het vervangen van de waarde "ONWAAR" en de twee getallen, die worden niet vervangen tenzij ik de macro via visual basic laat lopen. (Onderaan de programmatie code)

Code:

Sub afwerkenwerkblad()
'
' afwerkenwerkblad Macro
'

'
Sheets("FASTENERS").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Activate

Sheets("SMART").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Activate
    
        Selection.AutoFilter
        ActiveSheet.Range("$A$1:$I$1621").AutoFilter Field:=1, Criteria1:="0"
        ActiveCell.Offset(864, 0).Rows("1:759").EntireRow.Select
        Selection.Delete Shift:=xlUp
        ActiveSheet.Range("$A$1:$I$865").AutoFilter Field:=1
    
Sheets("DIY").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Activate
    
        Selection.AutoFilter
        ActiveSheet.Range("$A$1:$I$1621").AutoFilter Field:=1, Criteria1:="0"
        ActiveCell.Offset(864, 0).Rows("1:759").EntireRow.Select
        Selection.Delete Shift:=xlUp
        ActiveSheet.Range("$A$1:$I$865").AutoFilter Field:=1
        
Sheets("SMART BLISTER").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Activate
    
        Selection.AutoFilter
        ActiveSheet.Range("$A$1:$I$1621").AutoFilter Field:=1, Criteria1:="0"
        ActiveCell.Offset(864, 0).Rows("1:759").EntireRow.Select
        Selection.Delete Shift:=xlUp
        ActiveSheet.Range("$A$1:$I$865").AutoFilter Field:=1
        
Sheets("FG WOODCONNECTORS").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Activate
        
        Columns("A:A").Select
        Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
        Range("A2").Select
        ActiveCell.FormulaR1C1 = "=IF(R[-1]C[1]=RC[1],""wis"",""goed"")"
        Selection.AutoFill Destination:=Range("A2:A1071")
        Range("A2:A1071").Select
        
            Range("A1").Select
            Selection.AutoFilter
            ActiveSheet.Range("$A$2:$L$537").AutoFilter Field:=1, Criteria1:="wis"
            Rows("3:1000").Select
            Selection.Delete Shift:=xlUp
            Selection.AutoFilter
            
        Columns("A:A").Select
        Selection.Delete Shift:=xlToLeft
        
                Selection.AutoFilter
                ActiveSheet.Range("$A$1:$I$1621").AutoFilter Field:=1, Criteria1:="0"
                ActiveCell.Offset(864, 0).Rows("1:759").EntireRow.Select
                Selection.Delete Shift:=xlUp
                ActiveSheet.Range("$A$1:$I$865").AutoFilter Field:=1
    
Sheets("COSMOS").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Activate
    
        Selection.AutoFilter
        ActiveSheet.Range("$A$1:$I$1621").AutoFilter Field:=1, Criteria1:="0"
        ActiveCell.Offset(864, 0).Rows("1:759").EntireRow.Select
        Selection.Delete Shift:=xlUp
        ActiveSheet.Range("$A$1:$I$865").AutoFilter Field:=1
        
Sheets("SHARPWARE").Select
    Cells.Select
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("A1").Activate
    
        Selection.AutoFilter
        ActiveSheet.Range("$A$1:$I$1621").AutoFilter Field:=1, Criteria1:="0"
        ActiveCell.Offset(864, 0).Rows("1:759").EntireRow.Select
        Selection.Delete Shift:=xlUp
        ActiveSheet.Range("$A$1:$I$865").AutoFilter Field:=1
    
[B]Sheets("FG WOODCONNECTORS").Select
    Cells.Replace What:="ONWAAR", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
            
    Cells.Replace What:="9999999,99", Replacement:="OP AANVRAAG / SUR DEMANDE", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False
            
    Cells.Replace What:="4499999,99", Replacement:="OP AANVRAAG / SUR DEMANDE", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False[/B]
End Sub

Alvast bedankt voor de hulp.

Kolommen naar een nieuwe werkmap kopieren

VPE

Gebruiker

Bijlagen

Elsendoorn2134

Gebruiker

VPE

Gebruiker

Nieuwste berichten

Wij waarderen jouw privacy