Question

请帮我解决以下问题：
我在不同的纸张上有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

Answer 1

我的想法与@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

Answer 2

我通常使用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，但它不能处理来自不同工作表的多个范围。因此，在这种情况下，您必须手动执行此操作，将每个范围复制＆gt;＆gt;粘贴到下一个可用行中。

var div = $('#HELLO');
$('button').click(function() {
  div.find('.child').each(function(i) {
    if (!$(this).parent("div").hasClass("parent")) $(this).addClass('hurted').text('You hurt me!');
  });
});

多个范围按顺序粘贴到另一个工作表中

2 个答案: