특정 데이터를 복사하여 다른 시트에 붙여 넣기하는 VBA 코드

Question

VBA를 처음 사용하기 때문에이 코드를 작성하는 데 더 간단하고 효율적인 방법이 있어야하지만 올바른 기능에 익숙하지 않아야합니다 (예 : 기존 데이터 위에 붙여 넣지 않고 다음 워크 시트에 붙여 넣기). 작은 워크 시트에서도 작동하지만 60000+ 라인이있는 워크 시트에 사용해야합니다. 어떤 도움이라도 대단히 감사하겠습니다. 미리 감사드립니다.

Sub test() 
    Dim row As Long 
    With Excel.Application 
     .ScreenUpdating = False 
     .Calculation = Excel.xlCalculationManual 
     .EnableEvents = False 
    End With 

For row = 1 To 65500 
If ThisWorkbook.ActiveSheet.Cells(row, 14) <> "" Then 
    ThisWorkbook.ActiveSheet.Cells(row, 1).EntireRow.Copy 
    ThisWorkbook.ActiveSheet.Paste Destination:=ThisWorkbook.Sheets("SCO").Cells(row, 1) 
    ThisWorkbook.ActiveSheet.Cells(row + 1, 1).EntireRow.Copy 
    ThisWorkbook.ActiveSheet.Paste Destination:=ThisWorkbook.Sheets("SCO").Cells(row + 1, 1) 

End If 

Next 

For row = 1 To 65500 
If ThisWorkbook.Sheets("SCO").Cells(row, 14) = "" Then 
    ThisWorkbook.Sheets("SCO").Cells(row, 20).Value = 2 
End If 
Next 
For x = 65500 To 1 Step -1 
    If ThisWorkbook.Sheets("SCO").Cells(x, 3) = "" Then 
    ThisWorkbook.Sheets("SCO").Cells(x, 1).EntireRow.Delete 
End If 
Next 
For row = 1 To 65500 
If ThisWorkbook.Sheets("SCO").Cells(row, 20) = 2 Then 
    ThisWorkbook.Sheets("SCO").Cells(row + 1, 1).EntireRow.Insert shift:=xlDown 
End If 

Next 

With Excel.Application 
    .ScreenUpdating = True 
    .Calculation = Excel.xlAutomatic 
    .EnableEvents = True 
End With 

End Sub 

Answer 1

난 당신이 원하는 데이터를 필터링 한 다음 새 시트에 필터링 된 데이터를 복사 얻을 ActiveSheet.UsedRange.Copy를 사용하는 자동 필터를 사용하는 것이 좋습니다. 또한 65500으로가는 대신 모든 데이터를 반복해야 할 때 ActiveSheet.UsedRange.Rows.Count으로 이동하여 빈 셀을 반복하지 마십시오.

예 :

는

당신이 첫 번째 루프는 복사 열에서 보호 물을 14

For row = 1 To 65500 
    If ThisWorkbook.ActiveSheet.Cells(row, 14) <> "" Then 
     ActiveSheet.Cells(row, 1).EntireRow.Copy 
     ActiveSheet.Paste Destination:=ThisWorkbook.Sheets("SCO").Cells(row, 1) 
     ActiveSheet.Cells(row + 1, 1).EntireRow.Copy 
     ActiveSheet.Paste Destination:=ThisWorkbook.Sheets("SCO").Cells(row + 1, 1) 
    End If 
Next 

대신에 당신이 그것을 필터링 할 수있는 모든 데이터를 통해 반복하지 않는 모든 행과 같은 이 같은 결과를 복사

'Filter out blank rows in column 14 
ActiveSheet.UsedRange.AutoFilter Field:=14, Criteria1:="<>" 

'Copy and Paste the results to Sheet "SCO" 
If Sheets("SCO").Range("A1").Value = "" Then 
    ActiveSheet.UsedRange.Copy Destination:=Sheets("SCO").Range("A1") 
Else 
    ActiveSheet.UsedRange.Copy Destination:=Sheets("SCO").Cells(Sheets("SCO").UsedRange.Rows.Count, 1) 
End If 

을 또한 여기 어디 루프를 1 65500

,691에

For row = 1 To 65500 
    If Sheets("SCO").Cells(row, 14) = "" Then 
     Sheets("SCO").Cells(row, 20).Value = 2 
    End If 
Next 

당신은 내가 UsedRange에 익숙하지 않은 해요 당신이 루프

For row = 1 To Sheets("SCO").UsedRange.Rows.Count 
    If Sheets("SCO").Cells(row, 14) = "" Then 
     Sheets("SCO").Cells(row, 20).Value = 2 
    End If 
Next