Rijen kopieren met een macro en plakken in een ander totaal overzicht

[Djoties]

Help!!!!

Graag uw hulp.
Zie bijlage

Groetejs en alvast mijn dank

 

[Warme bakkertje]

Sub tst()
With Sheets("Formulier")
    .Range("A2:F" & .Cells(Rows.Count, 6).End(xlUp).Row).Copy [Totaal!A65536].End(xlUp).Offset(1)
End With
End Sub

 

[Djoties]

vervolg

Rudi,

Mijn dank is groooooooot.
Het werkt!!!
Ik heb alleen nog een vervolg vraag hierop.

Ik wil nu i.p.v. plakken in tabblad "database", een file openen en daarin plakken.
File staat b.v. op dir:

U:\DJOTIES\Tijdschrijven 2010


Groetjes

 

[Warme bakkertje]

Test onderstaande eens uit. Controleer eerst nog even de bestandsnamen en de werkbladnamen

Sub Overbrengen()
    Application.ScreenUpdating = False
    Dim wsFrom As Worksheet, wsTo As Worksheet
    Workbooks.Open ("U:\DJOTIES\Tijdschrijven 2010.xls ") 'Doelbestand"
    ThisWorkbook.Activate
    Set wsFrom = Workbooks("Voorbeeld.xls").Worksheets("Formulier") 'Bronwerkblad
    Set wsTo = Workbooks("Tijdschrijven 2010.xls").Worksheets("Blad1") 'Doelwerkblad
        wsFrom.Range("A2:F" & .Cells(Rows.Count, 6).End(xlUp).Row).Copy _
             wsTo.Cells(Rows.Count, 1).End(xlUp).Offset(1)
    [A1].Select
    Application.ScreenUpdating = True
    Workbooks("Tijdschrijven 2010.xls").Close True
End Sub

 

[Djoties]

foutmelding

Foutmeling bij .cell


sFrom.Range("A2:F" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy _

 

[Warme bakkertje]

wsFrom.Range("A2:F" & .Cells(Rows.Count, 6).End(xlUp).Row) _
                .Copy wsTo.Cells(Rows.Count, 1).End(xlUp).Offset(1)

 

[Djoties]

Ik heb id, 6 veranderd in 1. Omdat ik ook oncomplete data mee wilt nemen.

Maar ergens stop de macro en krijg ik een foutmelding bij .Cell
Macro moet door lopen en na het plakken moet deze "opslaan en bestand afsluiten en terug keren naar de bron doc

dankje wel

 

[Warme bakkertje]

Sorry, mijn fout.

Sub Overbrengen()
    Application.ScreenUpdating = False
    Dim wsFrom As Worksheet, wsTo As Worksheet
    Workbooks.Open ("U:\DJOTIES\Tijdschrijven 2010.xls ") 'Doelbestand"
    ThisWorkbook.Activate
    Set wsFrom = Workbooks("Voorbeeld.xls").Worksheets("Formulier") 'Bronwerkblad
    Set wsTo = Workbooks("Tijdschrijven 2010.xls").Worksheets("Blad1") 'Doelwerkblad
        wsFrom.Range("A2:F" & [COLOR="red"]wsFrom[/COLOR].Cells(Rows.Count, 1).End(xlUp).Row) _
                .Copy wsTo.Cells(Rows.Count, 1).End(xlUp).Offset(1)
    [A1].Select
    Application.ScreenUpdating = True
    Workbooks("Tijdschrijven 2010.xls").Close True
End Sub

 

[Djoties]

Rudi,

Het werkt Super!!!!!!!!!!

Mijn dank voor al je kennis en moeite.


Groetjes,

D

 

[Djoties]

Nog een vraag

haha,

ik heb nog een laatste vraag hierover (hoop ik)
Bij het plakken van de rijen wil ik dat deze alléén waarden plakt en dus geen formules meeneemt. (in mijn voorbeeld zijn er geen formules maar in het echt wel)

Mvgr,

Djoties

 

[Warme bakkertje]

Test

Sub Overbrengen()
    Dim wsFrom As Worksheet, wsTo As Worksheet
    Application.ScreenUpdating = False
    Workbooks.Open ("U:\DJOTIES\Tijdschrijven 2010.xls ") 'Doelbestand"
    ThisWorkbook.Activate
    Set wsFrom = Workbooks("Voorbeeld.xls").Worksheets("Formulier") 'Bronwerkblad
    Set wsTo = Workbooks("Tijdschrijven 2010.xls").Worksheets("Blad1") 'Doelwerkblad
        wsFrom.Range("A2:F" & wsFrom.Cells(Rows.Count, 1).End(xlUp).Row).Copy
        wsTo.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
    [A1].Select
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
    Workbooks("Tijdschrijven 2010.xls").Close True
End Sub

 

[Djoties]

Rudi, mijn dank voor je snelle reactie.

Maar....waar gaat het fout??
Hij slaat niet meer automatiche op!!!

Mvrgr.

D

 

[Warme bakkertje]

De aangebrachte wijziging heeft niets met het opslaan te maken, het is enkel een andere manier van waarden kopieëren en plakken.

 

[Djoties]

Klopt, er is niks veranderd.
Alleen ik ben zelf wezen k.......

Ik heb nu drie macro is met samenvoegen en daar gaat het ineens fout
(ik heb even de file benamingen veranderd)

Sub Macro1()
'
' Macro1 Macro
' De macro is opgenomen op 3-11-2010 door Djoties.





For Each c In Range("P2100")
If c <= 1 Then
c.Rows.EntireRow.Delete
End If
Next
With Sheets("database")
.Range("A2" & .Cells(Rows.Count, 1).End(xlUp).Row).Copy [Database!A100].End(xlUp).Offset(1)
Dim wsFrom As Worksheet, wsTo As Worksheet
Application.ScreenUpdating = False
Workbooks.Open ("U:\DJOTIES\Tijdschrijven november 2010.xls ") 'Doelbestand"
ThisWorkbook.Activate
Set wsFrom = Workbooks("Tijdschrijven 03-11-2010.xls").Worksheets("Database") 'Bronwerkblad
Set wsTo = Workbooks("Tijdschrijven november 2010.xls").Worksheets("Blad1") 'Doelwerkblad
wsFrom.Range("A2" & wsFrom.Cells(Rows.Count, 1).End(xlUp).Row).Copy
wsTo.Cells(Rows.Count, 1).End(xlUp).Offset(1).PasteSpecial xlPasteValues
[A1].Select
With Application
.CutCopyMode = False
.ScreenUpdating = True



Naam = Cells(1, 1).Value & ".xls"
ActiveWorkbook.SaveAs Filename:="u:\Djoties\" & Naam

End With
Workbooks("Tijdschrijven november 2010.xls").Close True



End With

End Sub

 

[Warme bakkertje]

Post de 3 aparte macro's eens (Gebruik code-tags voor de leesbaarheid) want je hebt alles door elkaar aan't klutsen geweest, lijkt mij.
zoals ik het zie ga je op een werkblad (Welk ????) een aantal rijen verwijderen die aan een bepaalde voorwaarde voldoen. Dan ga je op sheets Database een bereik kopieëren en dit onderaan terug bijplakken. Dit ganse bereik kopieër je naar een ander bestand dat je vervolgens hernoemd, maar niet afsluit. Gebruik insprongen in je code voor de leesbaarheid zodat je kan zien welke End With bij welke With hoort.