als opslaan verberg rijen

[johndirk]

hi allemaal

ik wil alle mijn records kopieren van blad1 naar blad 2 zonder leeg regels
ik heb de onderstaande macro gemaakt:

Sub Macro1()
Application.ScreenUpdating = False
'Dient om flikkeren tegen te gaan
Rows("7:14").Select
Selection.EntireRow.Hidden = True
Rows("5:5").Select
Selection.EntireRow.Hidden = True
Rows("4:6").Select
['blad1'!A2:b15].Copy
['Blad2'!A60000].End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
Selection.EntireRow.Hidden = False
Rows("6:15").Select
Selection.EntireRow.Hidden = False
Range("A10").Select
Application.ScreenUpdating = True
Application.CutCopyMode = False

End Sub

maar de macro werkt niet en verbergt geen cellen.
kan ik met een macro alle mijn records zonder leeg rijen bewaren in blad2?

veel dank

 

[danny147]

Beste johndirk

Wil je ze ook onder elkaar in Blad2 ?
Het is natturlijk veel gemakkelijker naast elkaar en overzichtelijker op blad 2
En waar wil je de 2de record dan zien ?

Anders een voorbeeldbestandje hoe je het wilt in Blad2.

Groetjes Danny. :thumb:

 

[johndirk]

macro

bedankt danny voor uw snelle reactie

ik mag niet de velden in andere plaats plaatsen.

a2 = naam
a3 = achternaam
a9 = salaris

ik wil de rijen a4:a8 verbergen bij het opslaan.
Kan ik blad1 zonder leeg regels opslaan op blad2 zodat alle records worden op blad 2 opgeslagen?

 

[danny147]

Beste johndirk

Plak deze code in een module.

Sub Kopie()
    Application.ScreenUpdating = False
   Dim c As Range
   For Each c In [A4:A6000]
        If c <> "" Then
            c.Rows.EntireRow.Copy
            ['Blad2'!A65536].End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
        End If
    Next
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
End Sub

Maak dan een koppeling met knop paste naar deze code.

Groetjes Danny. :thumb:

 

[johndirk]

macro

veel dank danny

bedankt voor uw snelle antwoord



nog een vraag hoe kan ik de records scheiden met een leeg regel in blad2?
nu alle records zijn zo dichtbij in blad2 wanneer ik gebruik de macro,
ik wil later de records in blad 2 kunnen opvolgen.
kan ik in blad 2 een lege regel tussen de records hebben?

 

[danny147]

Beste johndirk

In het vervolg maak je een nieuwe post aan ipv van de vorige aan te passen.
En zet deze terug als niet opgelost, anders gaat hier niemand meer op af komen.
In de berichten kan je dan ook niet zien dat je een aanpassing hebt gedaan.

PS: als je de kaders ook wil mee kopiëren verander dan:

xlPasteValues in xlPasteAll


Groetjes Danny. :thumb:

 

[trucker10]

veel dank danny

bedankt voor uw snelle antwoord



nog een vraag hoe kan ik de records scheiden met een leeg regel in blad2?
nu alle records zijn zo dichtbij in blad2 wanneer ik gebruik de macro,
ik wil later de records in blad 2 kunnen opvolgen.
kan ik in blad 2 een lege regel tussen de records hebben?

Zet gewoon :

Sub Kopie()
    Application.ScreenUpdating = False
   Dim c As Range
   For Each c In [A4:A6000]
        If c <> "" Then
            c.Rows.EntireRow.Copy
            ['Blad2'!A65536].End(xlUp).Offset([COLOR="Red"]2[/COLOR], 0).PasteSpecial xlPasteValues
        End If
    Next
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
End Sub

 

[danny147]

Beste trucker10

Bij deze gaat hij overal een lege regel tussen voegen, en het is de bedoeling van TS na elke 3 regels.
De records bestaan uit 3 regels.

Groetjes Danny. :thumb:

 

[trucker10]

Hallo Danny , ik had de vraag vlug gelezen en maar gepost , nu ik de vraag nog eens doorneem en de naam van TS bekijk hebben we in het verleden al eens met dit soort vraagje gespeeld http://www.helpmij.nl/forum/showthread.php?t=446067&page=2

 

[johndirk]

macro

bedankt Danny en trucker 10
veel dank voor uw help danny
ok danny u heeft helemaal gelijk mijn excuses danny

trucker10 oplossing inderdaad heeft 3 regels en ik wilde een regel tussen
de records zijn, trucker10 veel dank voor uw oplossing nu ga ik zelf aanpassen uw macro

prettige kerstdagen

 

[trucker10]

johndirk , je kan het via deze weg doen

Sub Macro2()
    Application.ScreenUpdating = False
    ['Blad1'!A3:B4].Copy
    ['Blad2'!A65536].End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
    ['Blad1'!A6:B6].Copy
    ['Blad2'!A65536].End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
    ['Blad1'!A15:B15].Copy
    ['Blad2'!A65536].End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll
    With Application
        .CutCopyMode = False
        .ScreenUpdating = True
    End With
End Sub

Wil je nu 2 rijen tussen wijzig dan ['Blad1'!A2:B4].Copy

 

[danny147]

Beste johndirk

Zie dan hier nog eens het bestandje met een nummer ertussen.

@ Trucker die van U is ook goed hé :thumb:

Groetjes Danny. :thumb:

 

[trucker10]

@ Danny , goed gevonden , overzichtelijk met het gekleurde nummer ertussen :thumb: :thumb: duidelijke afscheiding

 

[Warme bakkertje]

Sub tst()
Application.Union([A4:B4], [A6:B6], [A15:B15]).Copy
[Blad2!A65536].End(xlUp).Offset(2).PasteSpecial xlPasteValues
Application.CutCopyMode = False
End Sub

 

[danny147]

Beste Warme bakkertje

De code flikkerde een beetje, daarom wat aangepast alsook PasteAll.
Gaf de uren niet terug zoals ze moeten zijn.

Inderdaad met Union was ook een oplossing :thumb:

Sub tst()
Application.ScreenUpdating = False
Application.Union([A4:B4], [A6:B6], [A15:B15]).Copy
[Blad2!A65536].End(xlUp).Offset(2).PasteSpecial xlPasteAll
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub

Groetjes Danny. :thumb:

 

[johndirk]

macro

bedankt danny en trucker10 en Warme bakkertje en trucker10

uw oplossing danny was schitterend
veel dank danny
alles nu werkt bij de vergoedinglijst danny