Vba 多个范围按顺序粘贴到另一张图纸中

请帮我解决以下问题：
我在不同的工作表上有3个范围。
我必须复制每个范围（直到它的最后一行有数据和粘贴值，所有值都在“Rezultat”表上）（以使它们不会相互粘贴）

这是我的代码：

Sub MultipleRangesPaste()

Dim rng1 As Range, rng2 As Range, rng3 As Range, MultipleRng As Range

With ThisWorkbook.Sheets("REZULTAT")
    Set rng1 = Sheets("NEVOI PERSONALE").Range("F2:H" & Range("H" & Rows.Count).End(xlUp).Row)
    Set rng2 = Sheets("RATE").Range("F2:H" & Range("H" & Rows.Count).End(xlUp).Row)
    Set rng3 = Sheets("CARDURI").Range("G2:I" & Range("I" & Rows.Count).End(xlUp).Row)

    Set MultipleRng = .Range(rng1 & rng2 & rng3) ' AT THIS LINE DEBUG SAID IT IS A PROBLEM
End With

MultipleRng.Copy
With ThisWorkbook.Sheets("REZULTAT").Range("A2")
            .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
End With

End Sub

---

我通常使用

application.Union

，但它不适用于不同工作表中的多个范围。因此，在这种情况下，您必须手动执行此操作，将每个范围复制>>粘贴到下一个可用行中

Sub MultipleRangesPaste()

Dim rng1 As Range, rng2 As Range, rng3 As Range, MultipleRng As Range
Dim NextRow As Long

Set rng1 = Sheets("NEVOI PERSONALE").Range("F2:H" & Sheets("NEVOI PERSONALE").Cells(Sheets("NEVOI PERSONALE").Rows.Count, "H").End(xlUp).Row)
Set rng2 = Sheets("RATE").Range("F2:H" & Sheets("RATE").Cells(Sheets("RATE").Rows.Count, "H").End(xlUp).Row)
Set rng3 = Sheets("CARDURI").Range("G2:I" & Sheets("CARDURI").Cells(Sheets("CARDURI").Rows.Count, "I").End(xlUp).Row)

With ThisWorkbook.Sheets("REZULTAT")
    ' find current next empty row on Column A
    NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    rng1.Copy
    .Range("A" & NextRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False

    ' find current next empty row on Column A
    NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    rng2.Copy
    .Range("A" & NextRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False

    ' find current next empty row on Column A
    NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    rng3.Copy
    .Range("A" & NextRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
End With

End Sub

---

我通常使用

application.Union

，但它不适用于不同工作表中的多个范围。因此，在这种情况下，您必须手动执行此操作，将每个范围复制>>粘贴到下一个可用行中

Sub MultipleRangesPaste()

Dim rng1 As Range, rng2 As Range, rng3 As Range, MultipleRng As Range
Dim NextRow As Long

Set rng1 = Sheets("NEVOI PERSONALE").Range("F2:H" & Sheets("NEVOI PERSONALE").Cells(Sheets("NEVOI PERSONALE").Rows.Count, "H").End(xlUp).Row)
Set rng2 = Sheets("RATE").Range("F2:H" & Sheets("RATE").Cells(Sheets("RATE").Rows.Count, "H").End(xlUp).Row)
Set rng3 = Sheets("CARDURI").Range("G2:I" & Sheets("CARDURI").Cells(Sheets("CARDURI").Rows.Count, "I").End(xlUp).Row)

With ThisWorkbook.Sheets("REZULTAT")
    ' find current next empty row on Column A
    NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    rng1.Copy
    .Range("A" & NextRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False

    ' find current next empty row on Column A
    NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    rng2.Copy
    .Range("A" & NextRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False

    ' find current next empty row on Column A
    NextRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
    rng3.Copy
    .Range("A" & NextRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
End With

End Sub

---

我的想法与@Shai Rado的想法非常相似，但我并没有编写完整的代码（这是为OP设计的），我有一个函数，根据一列查找最后使用的行：

Option Explicit

Sub MultipleRangesPaste()

Dim rng1            As Range
Dim rng2            As Range
Dim rng3            As Range
Dim MultipleRng     As Range
Dim lngRowSource    As Long
Dim lngRowTarget    As Long
Dim lngRows         As Long

With ThisWorkbook.Sheets("REZULTAT")
    Set rng1 = Sheets("NEVOI PERSONALE").Range("F2:H" & Range("H" & Rows.Count).End(xlUp).Row)
    Set rng2 = Sheets("RATE").Range("F2:H" & Range("H" & Rows.Count).End(xlUp).Row)
    Set rng3 = Sheets("CARDURI").Range("G2:I" & Range("I" & Rows.Count).End(xlUp).Row)

End With

rng1.Copy
With ThisWorkbook.Sheets("REZULTAT").Range("A2")
            .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
End With

rng2.Copy
'here locate the last row of column A in ThisWorkbook.Sheets("REZULTAT") and paste from there

rng3.Copy
'here locate the last row of column A in ThisWorkbook.Sheets("REZULTAT") and paste from there

End Sub

Public Function last_row(Optional str_sheet As String, Optional column_to_check As Long = 1) As Long

    Dim shSheet  As Worksheet

        If str_sheet = vbNullString Then
            Set shSheet = ThisWorkbook.ActiveSheet
        Else
            Set shSheet = ThisWorkbook.Worksheets(str_sheet)
        End If

    last_row = shSheet.Cells(shSheet.Rows.Count, column_to_check).End(xlUp).Row

End Function

---

我的想法与@Shai Rado的想法非常相似，但我并没有编写完整的代码（这是为OP设计的），我有一个函数，根据一列查找最后使用的行：

Option Explicit

Sub MultipleRangesPaste()

Dim rng1            As Range
Dim rng2            As Range
Dim rng3            As Range
Dim MultipleRng     As Range
Dim lngRowSource    As Long
Dim lngRowTarget    As Long
Dim lngRows         As Long

With ThisWorkbook.Sheets("REZULTAT")
    Set rng1 = Sheets("NEVOI PERSONALE").Range("F2:H" & Range("H" & Rows.Count).End(xlUp).Row)
    Set rng2 = Sheets("RATE").Range("F2:H" & Range("H" & Rows.Count).End(xlUp).Row)
    Set rng3 = Sheets("CARDURI").Range("G2:I" & Range("I" & Rows.Count).End(xlUp).Row)

End With

rng1.Copy
With ThisWorkbook.Sheets("REZULTAT").Range("A2")
            .PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
            Application.CutCopyMode = False
End With

rng2.Copy
'here locate the last row of column A in ThisWorkbook.Sheets("REZULTAT") and paste from there

rng3.Copy
'here locate the last row of column A in ThisWorkbook.Sheets("REZULTAT") and paste from there

End Sub

Public Function last_row(Optional str_sheet As String, Optional column_to_check As Long = 1) As Long

    Dim shSheet  As Worksheet

        If str_sheet = vbNullString Then
            Set shSheet = ThisWorkbook.ActiveSheet
        Else
            Set shSheet = ThisWorkbook.Worksheets(str_sheet)
        End If

    last_row = shSheet.Cells(shSheet.Rows.Count, column_to_check).End(xlUp).Row

End Function

---

谢谢，这很好用：）这对未来也很好。谢谢，这很好用：）这对未来也很好。谢谢你的回答和帮助。欢迎。我希望您理解了

最后一行

函数的概念。@Vityta nice，关于函数，不确定在这种情况下是否有必要，但仍然很好谢谢您的回答和帮助。欢迎。我希望您理解

最后一行

函数的概念。@vityta nice，关于函数，不确定在这种情况下是否有必要，但仍然很好