Question

我有一张纸包含数据，如果满足条件，我想复制一个特定范围。

我有下面的代码可以正常工作，但是我只需要复制特定范围。

Sub cautare_copiere()

'1. declar si setez variabilele
'2. sterg rezultatele vechi
'3. cauta si lipeste intr-un nou tab

Dim datasheet As Worksheet 'de unde este informatia copiata
Dim raportsheet As Worksheet 'unde este copiata informatia
Dim familie As String
Dim ultimulrand As Integer
Dim i As Integer 'numaram randurile

'setez variable

Set datasheet = Sheet1
Set raportsheet = Sheet2
familie = raportsheet.Range("B2").Value
valoare = raportsheet.Range("D2").Value
cantitate = raportsheet.Range("F2").Value


'sterge datele din tab-ul Raport
raportsheet.Range("A6:L200").ClearContents 'ajustez range-ul de unde sterg datele - daca am informatie multa, il maresc
raportsheet.Range("A6:L200").ClearFormats



'se duce in tab-ul Copy, cauta si copiaza
datasheet.Select
ultimulrand = Cells(Rows.Count, 1).End(xlUp).Row

'cauta printre randuri si selecteaza informatia pe care o cautam

For i = 2 To ultimulrand
        If Cells(i, 5) = familie And Cells(i, 8) <= valoare And Cells(i, 7) <= cantitate Then 'daca numele din coloana E se potriveste, copiaza intregul rand
            Range(Cells(i, 1), Cells(i, 8)).Copy 'copiaza range-ul setat de la 1 la 8 (A la H)
            raportsheet.Select 'selecteaza tab-ul raport
            'Range("A200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteFormulasAndNumberFormats 'cauta primul rand fara informatii
            Range("A200").End(xlUp).Offset(1, 0).PasteSpecial xlPasteAll 'deseneaza margini
            Range("A6:L200").Sort Key1:=Range("H5"), Order1:=xlAscending
            datasheet.Select 'se intoarce in tab-ul Copy si continua sa cauta informatia
            End If

Next i


raportsheet.Select 'selecteaza tab-ul Raport cand cautarea a fost terminata

Range("B2").Select


End Sub

满足条件时，我仅需要复制第1、3、5、6、7和8列中的数据。

谢谢！

Answer 1

无需选择工作表-您可以在它们之间直接复制粘贴。

'...
'cauta printre randuri si selecteaza informatia pe care o cautam
With datasheet
    For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
        If .Cells(i, 5) = familie And .Cells(i, 8) <= valoare And _
                                      .Cells(i, 7) <= cantitate Then
            'copy range is *relative to the row*
            .Rows(i).Range("A1,C1,E1:H1").Copy _
                    raportsheet.Range("A200").End(xlUp).Offset(1, 0)

        End If
    Next i
End With

With raportsheet
    .Range("A6:L200").Sort Key1:=.Range("H5"), Order1:=xlAscending
    .Select
    .Range("B2").Select
End With

复制特定范围

1 个答案: