VBA : 비어있을 때까지 열을 추출하고 다음 시트에서 반복하십시오.

Question

친애하는 스택 오버플로 웜.

"Prodcuts.xlmx"파일에는 워크 시트 "Contract1"의 A 열에 수천 개의 숫자 값이 있습니다. 동일한 파일에는 "Contract2"라는 이름을 가진 유사한 워크 시트가 여러 개 있습니다. 행의 수는 각 워크 시트에서 변경되며 시간이 지남에 따라 동일한 워크 시트에서 변경 될 수 있지만 항상 빈 행이 뒤따라옵니다. 워크 시트 수는 고정적입니다

이 워크 시트의 정보를 하나의 워크 시트로 수집해야합니다. 열 A에 워크 시트 이름이 반복되고 숫자 열 B에 숫자 값이 포함 된 형식으로 "Productlist"라고 부를 수 있습니다.

나는이 정보를 단순히 복사하는 추출 루프를 사용하여 가능한 변경 사항에 대한 다중 검사를 피하기를 원합니다.

소스를 복사하기 위해 선택 열을 사용할 수 없습니다. 빈 셀 다음에 추가 데이터 세트가 필요하지 않습니다.

일반 아이디어는 "제품 목록"열 B에 복사, 빈 행까지,

가져 오기 WS1 열 콘텐츠입니다

WS1 WS 이름, "Produclist"열 A에 복사 열 B는이 때까지 반복 받기 값

는 WSN이 존재하지 않을 때까지,이 빈 행 WS2에 대한

반복을 추가 (또는 경기 수) (또는 열 B +1 행은 WS 이름의 한 여분의 행을 피하기 위해 값이 없습니다).

Answer 1

나는 다른 게시물에 유사한 soemthing에 대한 답변을했고, 조금 수정했습니다. 뭔가 그때 뭔가가 제거되었는지 확인에 대응해야 실현, 나는 형식을 보수하지 수는 "Contract1"에 추가 된 경우 내가 rowcounter 사용 및 점검으로 잘못 갔다

Sub testing() 
Dim resultWs As Worksheet 
Dim ws As Worksheet 
Dim dataArray As Variant 
Dim height As Long 
Dim currentHeight As Long 
Dim wsName As String 
Set resultWs = Worksheets("Productlist") 
For Each ws In Worksheets 
    If InStr(ws.Name, "Contract") Then 
     With ws 
      wsName = .Name 
      height = .Cells(1, 1).End(xlDown).Row 'look til empty row 
      If height > 1048575 Then 
       height = 1 
      End If 

      ReDim dataArray(1 To height, 1 To 1) 
      dataArray = .Range(.Cells(1, 1), .Cells(height, 1)).Value 

     End With 

     With resultWs 
      currentHeight = .Cells(.Rows.Count, 1).End(xlUp).Row 
      If .Cells(1, 1) = "" Then 
       currentHeight = 0 
      End If 
      If VarType(dataArray) <> vbDouble Then 
       .Range(.Cells(currentHeight + 1, 1), .Cells(currentHeight + UBound(dataArray, 1), 1)).Value = wsName 
       .Range(.Cells(currentHeight + 1, 2), .Cells(currentHeight + UBound(dataArray, 1), 2)).Value = dataArray 
      Else 
       .Cells(currentHeight + 1, 1).Value = wsName 
       .Cells(currentHeight + 1, 2).Value = dataArray 
      End If 

     End With 
    End If 

Next ws 

End Sub