lijn bijvoegen en inhoud verplaatsen van kolom

[grema]

Zoek naar een oplossing voor :

indien AD ; AE ; AF . AG; AH ; AI ; AJ. AK

Dan zou er telekens een lijn moeten bijgevoegd worden waarbij
AE
AF AG
AH
AI
AJ
AK

kan dit ook in 1 beweging

 

[Wigi]

Mark

Ik heb al heel wat vragen gelezen de afgelopen maanden, maar aan de deze kan ik kop noch staart krijgen.

 

[grema]

Sorry

te rap.

Heb een lijst van nrs naast elkaar van eenzelfde persoon.

vb :
naam in kolom J4

eerste nr in kolom AD
2de nr in kolom AE
enz

de bedoeling is nu dat ik deze opsplits mooi onder elkaar plaats met behoud van naam
in bijgevoegde lijn.
Dus niet meer naaste elkaar

Hopelijk iets duidelijker anders een vb ?


M.

 

[Wigi]

Deze vraag is volgens mij vrij gelijkaardig: http://www.worksheet.nl/forumexcel/showthread.php?p=483019

 

[grema]

liet volgende code lopen:

Sub Macro7()
'
' Macro7 Macro
' De macro is opgenomen op 27/11/2007 .
'

'
    Rows("6:6").Select
    Range("C6").Activate
    Selection.Insert Shift:=xlDown
    Range("AE5").Select
    Selection.Copy
    Range("AD6").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("J5").Select
    Application.CutCopyMode = False
    Selection.Copy
    Range("J6").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("J6").Select
    ActiveCell.FormulaR1C1 = _
        "G.O.M.B. - S.D.R.B.-a-G.O.M.B. - S.D.R.B.---Mireille /K"
    Range("AF5").Select
    Selection.Copy
    Rows("7:7").Select
    Range("C7").Activate
    Application.CutCopyMode = False
    Rows("7:7").Select
    Range("C7").Activate
    Selection.Insert Shift:=xlDown
    Range("AF5").Select
    Selection.Copy
    Range("AD7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("J6").Select
    Selection.Copy
    Range("J7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("J7").Select
    ActiveCell.FormulaR1C1 = _
        "G.O.M.B. - S.D.R.B.-a-G.O.M.B. - S.D.R.B.---Mireille /r"
    Range("AG5").Select
    Selection.Copy
    Rows("8:8").Select
    Range("C8").Activate
    Application.CutCopyMode = False
    Rows("8:8").Select
    Range("C8").Activate
    Selection.Insert Shift:=xlDown
    Range("AG5").Select
    Selection.Copy
    Range("AD8").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Rows("9:9").Select
    Range("C9").Activate
    Rows("9:9").Select
    Range("C9").Activate
    Selection.Insert Shift:=xlDown
    Range("AH5").Select
    Selection.Copy
    Range("AD9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("J7").Select
    Selection.Copy
    Range("J9").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("J9").Select
    ActiveCell.FormulaR1C1 = _
        "G.O.M.B. - S.D.R.B.-a-G.O.M.B. - S.D.R.B.---Mireille /fk"
    Rows("10:10").Select
    Range("C10").Activate
    Selection.Insert Shift:=xlDown
    Range("AI5").Select
    Selection.Copy
    Range("AD10").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("J9").Select
    Selection.Copy
    Range("J10").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("J10").Select
    ActiveCell.FormulaR1C1 = _
        "G.O.M.B. - S.D.R.B.-a-G.O.M.B. - S.D.R.B.---Mireille /fr"
    Rows("11:11").Select
    Range("C11").Activate
    Selection.Insert Shift:=xlDown
    Range("J11").Select
    ActiveWindow.SmallScroll Down:=-6
    Range("AJ5").Select
    Selection.Copy
    Range("AD11").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("J10").Select
    Selection.Copy
    Range("J11").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    Range("J11").Select
    ActiveCell.FormulaR1C1 = _
        "G.O.M.B. - S.D.R.B.-a-G.O.M.B. - S.D.R.B.---Mireille /fr"
    Rows("12:12").Select
    Range("C12").Activate
    Selection.Insert Shift:=xlDown
    Range("AJ5").Select
    Selection.Copy
    Range("AD12").Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("J11").Select
    Selection.Copy
    Range("J12").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = _
        "G.O.M.B. - S.D.R.B.-a-G.O.M.B. - S.D.R.B.---Mireille /g1"
    Rows("13:13").Select
    Range("C13").Activate
    Selection.Insert Shift:=xlDown
    Range("AK5").Select
    Selection.Copy
    Range("AD13").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Range("J12").Select
    Selection.Copy
    Range("J13").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = _
        "G.O.M.B. - S.D.R.B.-a-G.O.M.B. - S.D.R.B.---Mireille /g2"
    Range("AG9").Select
End Sub

nadeel is dat deze gebonden is aan 1 cel

en de namen specifiek gedefinieerd zijn .

Hoe kan ik deze verwijzen naar 1 volledig werkblad en de namen in de cel klant naam onafhankelijk maken van inhoud ???

 

[grema]

wigi


van jou link nog geen kaas gegeten .

Kan je geen hint geven op m'n code ?

thx

grema

 

[Wigi]

Kan je geen hint geven op m'n code ?

Ik kan zeggen dat je de macro recorder niet moet gebruiken, maar daar schiet je ook niets mee op als je niet kan programmeren.

Ga toch stap voor stap door de code, en begrijp wat er staat.

Vervolgens met een lus doorheen de cellen, en een Range variabele om naar cellen te verwijzen.

Nu ga ik mijn bed opzoeken, 't is goed geweest. 40 posts hier vandaag op het forum en 10 op andere forums. En de dag verlof is weeral voorbij ;-(

Morgen zal er wel iemand anders mee inspringen en code schrijven.

Succes ermee

Wigi

 

[grema]

vb in bijlage

collegas

hierbij een voorbeeld in bijlage .

Dit zal de boel verduidelijken. Heb geen kaas gegeten van loops ed.

Misschien kan iemand even bijspringen.

De kolommen die verborgen zijn , moeten wel degelijk behouden blijven.

Het bereik ongeveer 1500 lijnen .


alvast dank

 

[grema]

Plaatste volgende code ;

Sub SemiTranspose()
Dim i As Long, y As Long
Dim x As Integer
    
    i = 1
    y = 1

    Do Until IsEmpty(Cells(y, 3))
        For y = 2 To 3
            Cells(y, x + 1).Value = Cells(i, 2).Value
            y = y + 1
            Cells(y, x + 1).Value = Cells(i, 3).Value
            y = y + 1
            Cells(y, x + 1).Value = Cells(i, 4).Value
            y = y + 1
     Next y
     y = y + 1
    Loop

End Sub

dit lukt voor de waarden in cel B -- C--D

Maar nog niet voor andere waarden . Tevens geen rij invoegen .

Is dit reeds een goede start en hoe dan verder ??

voor de duidelijkheid : test in kolom A rij1 met bovenstande code gaat dit.

a) Indien ik nu dezelfde code op een andere plaats wil laten draaien vb vertrekkende vanaf kolom J Wat verander ik dan aan deze code wetende dat de 6 volgende cel van dezelfde rij onder elkaar dienen te staan?

b) Indien ik dit nu wens te herhalen in een tabblad met ongeveer 1200 lijnen of meer Hoe pas ik de code dan aan???

c) is er een oplossing voor het invoegen van rijen indien je de kolommen van horizonaal naar vertikaal brengt.

Je ziet ; ook ik ben reeds hard aan het zoeken gegaan ; maar zit nu weer even strop ????

 

[grema]

Lijn invoegen opgelost via link :


http://www.helpmij.nl/forum/showthread.php?t=327429

dank aan Leo


Nu nog even het probleem van horizonrtaal naar vertikaal

Waarvan ik reeds code aangaf in vraag . probleem hierbij blijft.

1) hoe verschuif ik naar andere kolomen ipv te starten op kolom 1 rij1
2) hoe voor gans de pagina

Iemand ?