从各种选项卡复制并粘贴到主表(VBA)

时间:2019-07-08 16:15:49

标签: excel vba

我需要一个代码来复制单元格std::variant(从第3行开始)中的所有选项卡中的所有内容,并将所有内容粘贴到从单元格A:H开始并向下移动的主选项卡中的所有内容?

我当前的代码是:

B5

此代码的问题在于,如果您多次执行此操作并且将其粘贴到低于已粘贴的位置,则不会返回到Sub CopyToMainsheet() Dim ws As Worksheet For Each ws In ThisWorkbook.Worksheets If ws.Name <> "Main" Then ws.Activate Range("A3:H3").Select Range(Selection, Selection.End(xlDown)).Copy Sheets("Main").Select Range("b" & Cells.Rows.Count).End(xlUp).Offset(1, 0).Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False End If Next End Sub 。我需要它才能每次开始粘贴到B5中。

预先感谢

1 个答案:

答案 0 :(得分:1)

尝试一下。如果要保留Main中的某些内容,则需要对其进行调整。

Sub CopyToMainsheet()

Dim ws As Worksheet, r As Long, r1 As Long

r = 5
With Worksheets("Main")
    r1 = .Range("B" & Rows.Count).End(xlUp).Row
    If r1 > 4 Then .Range("B5", .Range("B" & Rows.Count).End(xlUp)).Resize(, 8).ClearContents
End With

For Each ws In ThisWorkbook.Worksheets
    If ws.Name <> "Main" Then
        ws.Range("A3", ws.Range("A" & Rows.Count).End(xlUp)).Resize(, 8).Copy
        Sheets("Main").Range("B" & r).PasteSpecial Paste:=xlPasteValues, _
                                                   Operation:=xlNone, SkipBlanks:=False, Transpose:=False
        r = Sheets("Main").Range("B" & Rows.Count).End(xlUp).Row + 1
    End If
Next

End Sub