Mehrere Bereiche einfügen in ein anderes Blatt in Reihenfolge

Question

Bitte helfen Sie mir mit dem folgenden Problem:
Ich habe 3 Bereiche jeweils auf einem anderen Blatt.
Ich habe jeden Bereich (bis zu seiner letzten Zeile mit Daten und Paste Werten mit allen von ihnen auf dem Blatt „Rezultat“ (um zu kopieren, so dass sie sich nicht einfügen werden)

Dies ist mein Code :.

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 

Answer 1

ich in der Regel application.Union verwenden, aber es aus verschiedenen Arbeitsblättern auf mehrere Bereiche nicht funktioniert, also in diesem Fall, können Sie es manuell zu tun haben, kopieren >> jeden Bereich einfügen, in die nächste verfügbare Zeile

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 

Answer 2

Meine Idee ist so ähnlich wie die von @Shai Rado, aber ich habe nicht den ganzen Code geschrieben (das Vergnügen war für das OP gedacht) und ich habe eine Funktion, die die letzte Zeile auf der Basis von Spalte:

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