복사 행

Question

Dim LSearchRow As Integer 
Dim LCopyToRow As Integer 
Dim wks As Worksheet 
On Error GoTo Err_Execute 


For Each wks In Worksheets 
    ThisWorkbook.Worksheets.Add After:=Worksheets(Worksheets.Count) 
    Set wksCopyTo = ActiveSheet 
    wks.Rows(3).EntireRow.Copy wksCopyTo.Rows(3) 

    'Start search in row 4 
    LSearchRow = 4 
    'Start copying data to row 2 in Sheet2 (row counter variable) 
    LCopyToRow = 4 

    While Len(wks.Range("A" & CStr(LSearchRow)).Value) > 0 
     'If value in column E = "Mail Box", copy entire row to Sheet2 
     If wks.Range("AB" & CStr(LSearchRow)).Value = "Yes" And wks.Range("AK" & CStr(LSearchRow)).Value = "Yes" And wks.Range("BB" & CStr(LSearchRow)).Value = "Y" Then 
      'Select row in Sheet1 to copy 
      wks.Rows(CStr(LSearchRow) & ":" & CStr(LSearchRow)).Select 
      Selection.Copy 
      MsgBox "Copying Row" 
      'Paste row into Sheet2 in next row 
      wksCopyTo.Select 
      wksCopyTo.Rows(CStr(LCopyToRow) & ":" & CStr(LCopyToRow)).Select 
      wksCopyTo.Paste 
      MsgBox "Pasting Row" 
      'Move counter to next row 
      LCopyToRow = LCopyToRow + 1 
      'Go back to Sheet1 to continue searching 
      wks.Select 
     End If 
     LSearchRow = LSearchRow + 1 
    Wend 

    'Position on cell A3 
    Application.CutCopyMode = False 
    Range("A3").Select 
    MsgBox "All matching data has been copied." 
Next wks 

Exit Sub 
Err_Execute: 
    MsgBox "An error occurred." 

안녕

내가 다른 곳에서 제공된 코드에 따라 위의 코드를 가지고 값. if 문에 주어진 기준을 충족하는 행을 복사 할 때 기존 워크 시트마다 새 워크 시트를 작성하는 데 필요한 코드가 수정되었습니다. 내가 가진 문제는 다음과 같습니다.

1. 엑셀을 사용하면 코드를 실행하기 전에 존재하는 모든 워크 시트를 찾을 수 있으므로 루프를 반복하지 않아도됩니까?
2. 하나의 워크 시트에서 작업하면서 주어진 코드는 잠시 후에 실행되지 않고 왜 볼 수 없습니까?
3. 나는 그것이 32,000 행

누군가가 도와 드릴까요 후 충돌 하나의 워크 시트에서 실행 한 경우?

Answer 1

제가 하나 질문 하나를 답변 해 드리겠습니다 :

1. 예.과 같은 것을 사용하면 현재 통합 문서에있는 워크 시트 수를 반환 할 수 있습니다. 워크 시트를 통해 반복하는 가장 좋은 방법은 Worksheets 컬렉션을 통해 itterate하는 것입니다 그러나 :

   Dim wks As Worksheet 
   
   For Each wks In ThisWorkbook.Worksheets 
       'Do something 
       '... 
   Next wks 
   
   Set wks = Nothing 
   

2. 물론 당신이 얻을 때까지 당신은 결코, (당신이 열 A의 데이터> 32,000 행이있는 경우) 루프를 종료하지 않습니다 오버플로 오류 (정수는 32,767 +/-로 갈 수 있음).

3. 포인트 2를 참조하십시오. 정수의 한계를 초과하여 루핑 중입니다. 데이터 유형을 Long으로 변경하거나 포인트 2에 설명 된대로 루프를 종료하십시오.