Tabladen samenvoegen met Insert

[Moche56]

Een eenvoudige vraag denk ik maar niet voor mij :-(

In het macro onderaan worden de gegevens van DELFOR100 t/m DELFOR2300 in DELFORCUM gekopieerd.
Het kopiëren vindt plaats steeds onderaan het sheet.
Ik wil graag dat nieuwe gegevens steeds bovenaan gekopieerd worden (Insert)
Hoe moet de formule gewijzigd worden?

  With Sheets(SheetNames(i))
        .Range(.Range("M3"), .Cells(.Rows.Count, 1).End(xlUp)).Copy Sheets("DELFORCUM").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End With

Alvast bedankt voor de hulp
Mvgt,
Moché

Private Sub CommandButton1_Click()
'Sub CopyPasteDELFOR
Application.ScreenUpdating = False
SheetNames = Array("DELFOR1100", "DELFOR1400", "DELFOR1630", "DELFOR2300")
For i = LBound(SheetNames) To UBound(SheetNames)
    With Sheets(SheetNames(i))
        .Range(.Range("M3"), .Cells(.Rows.Count, 1).End(xlUp)).Copy Sheets("DELFORCUM").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End With
'
    With Sheets(SheetNames(i))
   .Range(.Range("M3"), .Cells(.Rows.Count, 1).End(xlUp)).ClearContents
    End With

Next i
Application.ScreenUpdating = True

End Sub

 

[snb]

Private Sub CommandButton1_Click()
  With Sheets("DELFORCUM")
    sn=.cells(1).currentregion
    .usedrange.clearcontents

    for each it in sheets(Array("DELFOR1100", "DELFOR1400", "DELFOR1630", "DELFOR2300"))
       .Cells(Rows.Count, 1).End(xlUp).Offset(1).resize(it.usedrange.rows.count)=it.usedrange.columns(13).offset(2).value
    next
    .Cells(Rows.Count, 1).End(xlUp).Offset(1).resize(ubound(sn),ubound(sn,2))=sn
  End With
End Sub

 

[Moche56]

Hallo snb,
Bedankt voor je reactie.
De code die je geeft verwijdert de gegevens in "DELFORCUM".
Dit is niet de bedoeling.
In elke sheet "DELFOR100, 1400, 1630 en 2300" staan een variabele aantal rijen beginnende in rij 3 en elke rij heeft 13 kolommen.
Met de macro moeten alle rijen en alle kolommen worden overgenomen in "DELFORCUM".
Bij het volgende keer activeren van de macro moeten de eerste gegevens (alle 13 kolommen) naar beneden schuiven en de nieuwe gegevens bovenaan gekopieerd worden.

Ik hoop dat ik duidelijk ben

Mvrg
Moché

 

[snb]

Nou, dan pas je mijn code toch eenvoudig aan.

PS. Mijn code verwijdert helemaal niet de gegevens in het werkblad delforcum.

 

[Moche56]

Hallo snb,

Excuses. Je code verwijdert de gegevens in Delforcum niet, maar het doet niet wat ik nodig heb.
Het kopieert alleen de 13e kolom uit de 4 tabs naar Delforcum
Ook blijven de gegevens in de 4 tabs staan. Met de oorspronkelijke code worden ze gewist.

Misschien gebruik ik het niet goed: Is je code een vervanging van de hele macro of alleen van een deel daarvan?:

   [I]With Sheets(SheetNames(i))
        .Range(.Range("M3"), .Cells(.Rows.Count, 1).End(xlUp)).Copy Sheets("DELFORCUM").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End With[/I]

Het aanpassen van je code gaat mijn kennis te boven helaas.
i.i.g. bedankt voor het proberen.

Grt,
Moché

 

[huijb]

@Moche56 Code dient tussen de codetags geplaatst te worden. Hiermee is het beter leesbaar voor de helpers. Zie ook hier http://www.helpmij.nl/forum/showthr...-de-helpers-in-deze-sectie-van-dienst-te-zijn

 

[Moche56]

Ok.
Bedankt voor de info.
Grt,
Moché

 

[Moche56]

Nog niet opgelost

Hallo,

Hulp is nog steeds welkom
In onderstaande macro worden de gegevens uit meerdere sheets in een sheet gekopieerd.
Nieuwe gegevens worden steeds onderaan gekopieerd maar ik wil ze graag boven aan de sheet. Oude gegevens moeten naar onder geschoven worden.

mvg,
Moché

Private Sub CommandButton1_Click()
'Sub CopyPasteDELFOR
Application.ScreenUpdating = False
SheetNames = Array("DELFOR1100", "DELFOR1400", "DELFOR1630", "DELFOR2300")
For i = LBound(SheetNames) To UBound(SheetNames)
    With Sheets(SheetNames(i))
        .Range(.Range("M3"), .Cells(.Rows.Count, 1).End(xlUp)).Copy Sheets("DELFORCUM").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End With
'
    With Sheets(SheetNames(i))
   .Range(.Range("M3"), .Cells(.Rows.Count, 1).End(xlUp)).ClearContents
    End With

Next i
Application.ScreenUpdating = True

End Sub

 

[Warme bakkertje]

Private Sub CommandButton1_Click()
  With Sheets("DELFORCUM")
    For Each it In Sheets(Array("DELFOR1100", "DELFOR1400", "DELFOR1630", "DELFOR2300"))
       sn = .Cells(1).CurrentRegion.Offset(1)
       .Cells(1).CurrentRegion.Offset(1).ClearContents
       .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(it.UsedRange.Rows.Count, it.UsedRange.Columns.Count) = it.UsedRange.Offset(2).Value
       .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(sn), UBound(sn, 2)) = sn
    Next
  End With
End Sub

 

[Moche56]

Hallo Rudi,

Het is bijna wat ik zoek

1. De aangepaste code copier vanaf regel 2 ipv regel 3.
Ik heb wijzigingen aan de parameters gebracht maar kom er niet uit.

2. De 4 tabs moeten leeg gemaakt worden na het kopiëren.

In het bijgevoerd bestand staan twee "knopen"
Knop 1: met de eerste code door mij gemaakt (doet wat er moet maar kopieer de gegevens onderaan)
Knop 2 met de code die je gaf.
Ik hoop dat hiermee het verschil beter te zien is.

Bekijk bijlage test gegevens samenvoegen Copy of Insert.xls

Het bestand is geen .Xlsm omdat die te groot was voor upload.

Ik hoop dat je me (weer) kan helpen
Alvast bedankt
Grt,
Moché

 

[Warme bakkertje]

Private Sub CommandButton2_Click()
  With Sheets("DELFORCUM")
    For Each it In Sheets(Array("DELFOR1100", "DELFOR1400", "DELFOR1630", "DELFOR2300"))
       sn = .Cells(2, 1).CurrentRegion.Offset(1)
       .Cells(2, 1).CurrentRegion.Offset(1).ClearContents
       .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(it.UsedRange.Rows.Count, it.UsedRange.Columns.Count) = it.UsedRange.Offset(1).Value
       it.UsedRange.Offset(1).ClearContents
       .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(sn), UBound(sn, 2)) = sn
    Next
  End With
End Sub

 

[Moche56]

Hallo Rudi,
Super. Het werkt perfect
Je hulp is zeer gewaardeerd.
"Kennis is macht". Met een paar regel worden veel handelingen tot eenvoud gebracht
Ik heb een aanvullend vraag:
In kolom "N" en "O" van DELFOR100-1400-1630-2300 heb ik formules staan. En in DELFORCUM ook in kolom "N" en "O" heb ik formules staan maar dan andere dan in de andere tabs.
Is het mogelijk het kopiëren te begrenzen tot een aantal kolommen? in de eerste code was "M3" de grens.
Wederom, alvast bedankt.
Mvgr,
Moché

 

[Warme bakkertje]

Private Sub CommandButton2_Click()
  With Sheets("DELFORCUM")
    For Each it In Sheets(Array("DELFOR1100", "DELFOR1400", "DELFOR1630", "DELFOR2300"))
       sn = .Cells(2, 1).CurrentRegion.Offset(1).Resize(, 13)
       .Cells(2, 1).CurrentRegion.Offset(1).Resize(, 13).ClearContents
       .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(it.UsedRange.Rows.Count, 13) = it.UsedRange.Offset(1).Resize(, 13).Value
       it.UsedRange.Offset(1).Resize(, 13).ClearContents
       .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(UBound(sn), UBound(sn, 2)) = sn
    Next
  End With
End Sub

 

[Moche56]

Rudi,
Het doet wat ik nodig heb.
Ik hoop dat ik je niet van je slaap heb gehouden
Mijn dank is groot.

Ik zet de status op opgelost.

Grt,
Moché