CODEWITHSUNDEEP
vbaexcel
user1669649
user1669649

Reputation:

Selecting rows until empty cell

I am attempting to create a macro that will pull data from several sheets and display them in an 'OVERVIEW' sheet.

At the moment I have the following:

Sheets("Sheet1).Select
ActiveCell.Range("A1:G7").Select
SELECTION.Copy
Sheets("OVERVIEW").Select
ActiveCell.Select
ActiveSheet.Paste
Sheets("Sheet2").Select
ActiveCell.Range("A1:G7").Select
Application.CutCopyMode = False
SELECTION.Copy
Sheets("OVERVIEW").Select
ActiveCell.Offset(7, 0).Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet3").Select
ActiveCell.Range("A1:G2").Select
Application.CutCopyMode = False
SELECTION.Copy
Sheets("OVERVIEW").Select
ActiveCell.Offset(7, 0).Range("A1").Select
ActiveSheet.Paste
ActiveWindow.SmallScroll Down:=-12
ActiveCell.Columns("A:A").EntireColumn.EntireColumn.AutoFit
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Application.CutCopyMode = False

Unfortunately, this currently only copies the data from the first sheet. I would much rather have something along the lines of the following pseudo code

sub COPY1()
Selection = []
curentRow = 1
while(notEmpty(cell(AcurentRow)))
    Selection.add(curentRow)
    curentRow++
return Selection
End Sub

sub PASTE1(selection)
curentRow=1
while(notEmpty(cell(AcurentRow)))
    curentRow++

paste(selection)
End Sub

Upvotes: 2

Views: 774

Answers (2)

Yuri Molodyko
Yuri Molodyko

Reputation: 600

sub copy_to_overview()

    currentRow = 1

    while (notempty(cell(currentrow))

      currentrow.copy

      sheet("overwiev").currentrow.paste
      currentrow = currentrow + 1

    wend

end sub

Upvotes: 2

Davesexcel
Davesexcel

Reputation: 6984

You can loop through the sheets, and it will skip over "OVERVIEW"

Sub Button1_Click()
    Dim ws As Worksheet, sh As Worksheet, LstRw As Long
    Set ws = Sheets("OVERVIEW")
    For Each sh In Sheets
        If sh.Name <> ws.Name Then
            With sh
            LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
                .Range("A1:G" & LstRw).Copy
                ws.Cells(ws.Rows.Count, "A").End(xlUp).Offset(1).PasteSpecial xlPasteValues
            End With
        End If
    Next sh
    Application.CutCopyMode = False
End Sub

Upvotes: 2

Related Questions