Question

我正在尝试创建一个宏，它将从多个工作表中提取数据并将其显示在“OVERVIEW”工作表中。

目前我有以下内容：

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

不幸的是，这目前只复制第一张表中的数据。我宁愿在下面的伪代码

中找到一些东西

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

Answer 1

sub copy_to_overview()

    currentRow = 1

    while (notempty(cell(currentrow))

      currentrow.copy

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

    wend

end sub

Answer 2

您可以遍历工作表，它将跳过“概述”

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

选择行直到空单元格

2 个答案: