Samenvoegen tabblad rijen

[stefano]

beste,

Onderstaande code heb ik gevonden op het net. Ik wil de inhoud van verschillende tabbladen samenbrengen op 1 nieuw tabblad. Ik kom er echter niet toe om rijen 5 tot de laatste rij per tabbald te selecteren. Kan iemand helpen aub?

dank.

Sub Combine()
Dim J As Integer
On Error Resume Next

Sheets(1).Select
Worksheets.Add
Sheets(1).Name = "Combined"
Sheets(2).Activate
Range("A1:A4").EntireRow.Select
Selection.Copy Destination:=Sheets(1).Range("A1")

For J = 2 To Sheets.Count
Sheets(J).Activate
Range("A1").Select [COLOR="#FF0000"]'hier zou ik willen kopiëren van rij 5 tot de laatste rij (= variabel voor elke sheet)[/COLOR]
Selection.CurrentRegion.Select
Selection.Offset(1, 0).Resize(Selection.Rows.Count - 1).Select
Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
Next
End Sub

 

[lam201]

prober dit eens:

Sub Combine_201()

Dim J As Integer
Dim Ws As Worksheet
Dim r As Long, rr as Long

Worksheets.Add
Sheets(1).Name = "Combined"

Sheets("Belgie").Range("A1:T4").Copy
Sheets("Combined").Range("A1").PasteSpecial

For J = 1 To 3

    If J = 1 Then Set Ws = Sheets("Belgie")
    If J = 2 Then Set Ws = Sheets("Duitse")
    If J = 3 Then Set Ws = Sheets("Engelse")
    
    r = WorksheetFunction.CountA(Ws.Range("A:A")) + 1
    rr = WorksheetFunction.CountA(Sheets("Combined").Range("A:A")) + 1
    Ws.Range("A5:T" & r).Copy
    Sheets("Combined").Range("A" & rr + 1 & ":T" & rr + r + 1).PasteSpecial

Next
End Sub

 

[Willempie2016]

Algemene methode gebiedsbepaling

Een algemeen werkbare methode om een gebied te selecteren en te printen staat hieronder.
In het bijgeleverde bestand staat in U1 de formule voor de laatste regel.
Je kunt dit vaak eenvoudiger doen maar dan is de kans op missers groter; deze werkt altijd.
Als je de tekstkleur van U1 wit maakt zie je het niet meer maar je kunt U1 ook verplaatsen naar een andere cel buiten het zichtbare deel van het beeldscherm.
Dan moet je uiteraard dit aanpassen in de formule bij de laatste printrij.

' Declareer variabelen
Dim LinkerPrintKolom As Long
Dim RechterPrintKolom As Long
Dim EerstePrintRij As Long
Dim LaatstePrintRij As Long



' Bepaal waarden van gebied (in jouw geval)
LinkerPrintKolom = 1
RechterPrintKolom = 1
EerstePrintRij = 5
LaatstePrintRij = Range("U1")

' Selecteer Printgebied
ActiveSheet.Range(ActiveSheet.Cells(EerstePrintRij, LinkerPrintKolom), ActiveSheet.Cells(LaatstePrintRij, RechterPrintKolom)).Select

' Druk selectie af
Selection.PrintOut Copies:=1, Collate:=True

ActiveSheet.PageSetup.PrintArea = ""
With ActiveSheet.PageSetup
.Zoom = 100
End With

 

[VenA]

Sub VenA()
  If IsError(Evaluate("Combined!A1")) Then Sheets.Add(Sheets(1)).Name = "Combined"
  For Each sh In Sheets
    If sh.Name <> "Combined" Then sh.Cells(3, 1).CurrentRegion.Offset(4).Copy Sheets("Combined").Cells(Rows.Count, 1).End(xlUp).Offset(1)
  Next sh
End Sub

 

[stefano]

Dank jullie voor de oplossingen. Ik ga aan de slag en test het uit !

dank!