variabel aantal sheets kopieren naar 1 sheet

[peter59]

Hallo,

Ik wil onderstaande code van VenA gebruiken.
Ten eerste is het de bedoeling om alle sheets op 1 sheet te krijgen.
Nu kopieert de code van alle sheets alleen maar kolom A en zet deze neer vanaf cel A2. Dit had ik graag in A1 gehad en dan alle kolommen die voorkomen.
Tevens kan het aantal sheets variabel zijn dus is het ook de bedoeling dat de code alles "na loopt".
Ik gebruik Excel 2010 (.xlsx)
Al eens bij Ron de Bruin rond gesnuffeld maar kan daar helaas geen code ontdekken die doet wat ik graag had gewilt.

Sub CopyPaste()

Application.ScreenUpdating = False
SheetNames = Array("Rapport", "Rapport1", "Rapport2", "Rapport3", "Rapport4")

With Sheets("Master")
    .Range(.Range("A1"), .Cells(.Rows.Count, 1).End(xlUp)).ClearContents
End With

For i = LBound(SheetNames) To UBound(SheetNames)
    With Sheets(SheetNames(i))
        .Range(.Range("A1"), .Cells(.Rows.Count, 1).End(xlUp)).Copy Sheets("Master").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    End With
Next i
Application.ScreenUpdating = True

End Sub

Alvast wederom dank voor het meedenken.

Mvg
Peter

 

[ExcelAmateur]

Dit is vorige week behandeld.
Zoek op " Tabbladen samenvoegen met macro"

 

[peter59]

Hallo ExcelAmateur

Dank voor de tip.
Ik weet niet wat er aan de hand is maar geen enkele code doet het.
Plak ik de code die in mijn vraagstelling staat dan doet de code het wel maar dan zoals ik al beschreven had.
Ik vind het heel vreemd allemaal.

Mvg
Peter

 

[VenA]

Welke van de enkele codes die je geprobeerd hebt doen het allemaal niet? Kan je even een bestandje uploaden?

Deze zal het bv wel doen. Mits je een tab 'master' hebt waarin de gegevens verzameld moeten worden. En er altijd data in kolom A staat.

Sub VenA()
With Sheets("master")
    .Cells.Delete
        For Each sh In Sheets
            If sh.Name <> "Master" Then sh.UsedRange.Copy .Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
        Next sh
     .Rows(1).EntireRow.Delete
End With
End Sub

Beter is het om helemaal geen copy te gebruiken als je alleen de waarden wil verzamelen.

 

[ExcelAmateur]

Ik heb getracht de macro van "snb" aan te passen.

Test hem.

Sub M_snb()
  With Sheets("Master")
    .UsedRange.ClearContents
  End With
  
  For Each sh In Sheets
    If UCase(Left(sh.Name, 1)) = "R" Then
       With sh.Cells(1).CurrentRegion
          Sheets("Master").Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(.Rows.Count, .Columns.Count) = .Value
       End With
    End If
  Next
 Sheets("Master").Rows(1).Delete xlUp
End Sub

 

[HSV]

Of als er geen 'cells(1).currentregion' is, maar allemaal losse bereiken (ergens).
Dus niet afhankelijk van cells(rows.count,1).end(xlup)

Sub hsv()
Dim i As Long, y As Long
Application.ScreenUpdating = False
With Sheets("Master")
    .UsedRange.ClearContents
  For i = 1 To Sheets.Count
   If UCase(Sheets(i).Name) <> "MASTER" Then
     y = y + 1
    Sheets(i).Range(Sheets(i).Range("a1"), Sheets(i).Cells.SpecialCells(11).Address).Copy .Cells(Rows.Count, .UsedRange.Column).End(xlUp).Offset(IIf(y > 1, 1, 0))
   End If
  Next i
 End With
End Sub

 

[peter59]

Hallo,

Vreemd, vreemd, vreemd!!!
Alle codes doen het nu ineens wel.
Ik weet helemaal niet waar het aan gelegen heeft. Iedere code van jullie doet wat er van gevraagd wordt.

Ik wil jullie heel hartelijk danken voor de genomen moeite.

Mvg
Peter