kopieeren zoeken en plakken.VBA

[rvt1982]

Beste Leden,

Wie kan mij helpen,

Ik heb de volgende code, en wil graag dat deze in Bestand1.xls de kopie maakt van de betreffende teksten en in Bestand2.xls gaat zoeken en gaat plakken.

alvast bedankt.

Sub zoekenenvervangen()

  With Application
    .ScreenUpdating = False
    
    Sheets("Blad1").Range("H5:J5").Copy
    Sheets("Blad3").Columns(2).Find(Sheets("Blad1").Range("G5").Value, , xlValues, xlWhole) _
                .Offset(, 3).PasteSpecial Paste:=xlPasteValues
                
    .CutCopyMode = False
    .ScreenUpdating = True
  End With
End Sub

 

[edmoor]

Dat is mooi.
En wat is nu je vraag?

 

[rvt1982]

@edmoor:
klein type foutje, wel=wil

deze script doet nu alles in 1 bestand, maar wil graag dat deze in de eerste bestand zijn kopie doet en in een andere excel bestand gaat zieken en plakken.

 

[rvt1982]

Beste Leden,

zelf heb ik dit al gemaakt, alleen deze werkt niet.
wie kan mij vertellen wat ik fout doe ??

Alvast bedankt.

Sub zoekenenvervangen()

  Application.ScreenUpdating = False
    Windows("g:\DATA.xls").Sheets("HuidigeZieken").Range("H5:J5").Copy
    Workbooks.Open Filename:="g:\DATA.xls"
    Windows("g:\DATA.xls").Sheets("Blad3").Columns(2).Find(Windows("g:\AGENDA.xls").Sheets("Blad3").Range("G5").Value, , xlValues, xlWhole) _
                .Offset(, 3).PasteSpecial Paste:=xlPasteValue
    ActiveWorkbook.Close Savechanges:=True
    Windows("g:\AGENDA.xls").Activate

  With Application
    .CutCopyMode = False
    .ScreenUpdating = True
  End With
  
End Sub

 

[rvt1982]

Weet iemand hier een oplossing voor mij ??

Alvast bedankt.

 

[Warme bakkertje]

Ga eens aan de slag met deze

Sub zoekenenvervangen()
  Application.ScreenUpdating = False
    Workbooks.Open Filename:="g:\DATA.xls"
    With ActiveWorkbook
        .Sheets("HuidigeZieken").Range("H5:J5").Copy
        .Sheets("Blad3").Columns(2).Find(ThisWorkbook.Sheets("Blad3").Range("G5").Value, , _
                    xlValues, xlWhole).Offset(, 3).PasteSpecial xlPasteValues
        .Close True
    End With
  ThisWorkbook.Activate
  With Application
    .CutCopyMode = False
    .ScreenUpdating = True
  End With
End Sub

 

[rvt1982]

@Warme bakkertje, deze code werkt helaas ook niet.


OEPS.... sorry jongens. nu snap ik waarom bijna niemand reageert..
Ik had een fout in de code voor de uitleg.

hierbij de verbeterde versie.

Kopiëren: g:\AGENDA.xls").Sheets("Blad3").Range("H5:J5").Copy
zoekwaarde: g:\AGENDA.xls").Sheets("Blad3").Range("G5").Value
zoeken en plakken: g:\DATA.xls").Sheets("Blad3").Columns(2)

Sub zoekenenvervangen()

  Application.ScreenUpdating = False
    Windows("g:\Agenda.xls").Sheets("Blad3").Range("H5:J5").Copy
    Workbooks.Open Filename:="g:\DATA.xls"
    Windows("g:\DATA.xls").Sheets("Blad3").Columns(2).Find(Windows("g:\AGENDA.xls").Sheets("Blad3").Range("G5").Value, , xlValues, xlWhole) _
                .Offset(, 3).PasteSpecial Paste:=xlPasteValue
    ActiveWorkbook.Close Savechanges:=True
    Windows("g:\AGENDA.xls").Activate

  With Application
    .CutCopyMode = False
    .ScreenUpdating = True
  End With
  
End Sub

 

[Warme bakkertje]

Sub zoekenenvervangen()
  Application.ScreenUpdating = False
    Workbooks.Open Filename:="G:\DATA.xls"
    With ActiveWorkbook
        ThisWorkbook.Sheets("Blad3").Range("H5:J5").Copy
        .Sheets("Blad3").Columns(2).Find(ThisWorkbook.Sheets("Blad1").Range("G5").Value, , _
                    xlValues, xlWhole).Offset(, 3).PasteSpecial xlPasteValues
        .Close True
    End With
  With Application
    .CutCopyMode = False
    .ScreenUpdating = True
  End With
End Sub

 

[rvt1982]

Super bedankt Rudi,

Deze werkt helemaal.
dit is van mij wel een heel stom foutje, zo iets kleins...

Bedankt.