Question

我是VBA的新手，主要将其与创建宏结合使用。从下面的代码中可以看出，我试图从三个不同的选项卡中获取表并将它们合并为一个。但是，我很难理解如何确保每个表直接粘贴到上一个表的下面而不会覆盖它（特别是每个月创建新行时）。

提前感谢您提供的任何帮助。

' Step_4_Combination_Tab Macro

    Sheets("Past Data").Select
    Range("A2:M2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Sheets("Combination").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
    Selection.End(xlDown).Select
    Range("A5483").Select
    Sheets("Actual").Select
    Range("A5:M5").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Combination").Select
    Range("A5483").Select
    ActiveSheet.Paste
    Range("A5483").Select
    Selection.End(xlDown).Select
    Range("A8341").Select
    Sheets("Forecast").Select
    Range("A4:M4").Select
    Range(Selection, Selection.End(xlDown)).Select
    Application.CutCopyMode = False
    Selection.Copy
    Sheets("Combination").Select
    ActiveSheet.Paste
    Selection.End(xlUp).Select
End Sub

Answer 1

以下代码可能会执行您想要的操作：

Sub mergeSheets()
    Set targetSheet = Sheets("Combination")
    For i = 1 To Sheets.Count
        If Sheets(i).Name <> "Combination" Then
            Last = LastRow(Sheets("Combination"))
            Sheets(i).UsedRange.Copy targetSheet.Cells(Last + 1, 1)
        End If
    Next i
End Sub

Function LastRow(sh As Worksheet)
LastRow = sh.Cells.Find(What:="*", _
                        After:=sh.Range("A1"), _
                        Lookat:=xlPart, _
                        LookIn:=xlFormulas, _
                        SearchOrder:=xlByRows, _
                        SearchDirection:=xlPrevious, _
                        MatchCase:=False).Row
End Function

从这里获取的一些代码位https://www.exceltip.com/cells-ranges-rows-and-columns-in-vba/copy-the-usedrange-of-each-sheet-into-one-sheet-using-vba-in-microsoft-excel.html

Answer 2

您需要找到包含数据的最后一行，并在那里粘贴下一个表。

    LR = Sheets("Combination").Range("A" & Rows.Count).End(xlUp).Row
    Pasterange = "A" & LR
    Sheets("Combination").Range(Pasterange).Paste

Answer 3

我猜您要复制标签中的数据＆＃34;过去的数据＆＃34;，＆＃34;实际＆＃34;和＆＃34;预测＆＃34;到＆＃34;合并＆＃34;。我对吗？由于一些奇怪的原因，源工作表中的数据开始于不同的行。我会这样做：

Sub AllToCons()
CopyToCons "Past data", 2
CopyToCons "Actual", 5
CopyToCons "Forecast", 4
End Sub

Sub CopyToCons(wsName As String, lRow As Long)
'wsName: name of sheet we are copying from
'lRow: number of row where data start

Dim ws As Worksheet
Dim wsCons As Worksheet
Dim rng As Range

Set wsCons = ThisWorkbook.Worksheets("Consolidated")
Set ws = ThisWorkbook.Worksheets(wsName)

With ws
Set rng = Range(.Range("A" & lRow), .Range("M" & .Cells.Rows.Count).End(xlUp))
End With

rng.Copy

With wsCons
.Range("A" & .Cells.Rows.Count).End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll 
End With

如果只想粘贴值，请键入xlPasteValues而不是xlPasteAll。希望它有所帮助。

需要帮助更正VBA /宏代码以将多个选项卡合并为一个

3 个答案: