수식이있는 행을 주 시트로 복사

Question

견적 원가 계산을 수행하는 통합 문서가 있습니다. "Costing Sheet"라는 메인 시트와 다른 이름을 가진 개별 시트가 있습니다. 모든 시트의 첫 번째 행은 헤더와 동일한 형식입니다. 난 그냥 원가 계산 시트에서 열 A의 값을 검색하고 다른 시트의 열 A의 값과 비교하고 발견 된 사본이 있으면 수식과 형식이있는 개별 시트의 전체 행 A : W를 원가 계산 시트 "를 일치하는 값과 비교합니다. 모든 데이터를 복사하고 새 시트를 만드는 매크로를 만들었습니다. 하지만 그건 내가 원하는 출력을주지 않습니다. 여러 포럼을 검색했지만 couldnt는 같은 것을 찾습니다. 당신이 엄청나 내가

Sub CopyFromWorksheets() 
Dim wrk As Workbook 
Dim sht As Worksheet 
Dim trg As Worksheet 
Dim rng As Range 
Dim colCount As Integer 
Set wrk = ActiveWorkbook 

For Each sht In wrk.Worksheets 
    If sht.Name = "Master" Then 
     MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _ 
     "Please remove or rename this worksheet since 'Master' would be" & _ 
     "the name of the result worksheet of this process.", vbOKOnly + vbExclamation, "Error" 
     Exit Sub 
    End If 
Next sht 


Application.ScreenUpdating = False 


Set trg = wrk.Worksheets.Add(After:=wrk.Worksheets(wrk.Worksheets.Count)) 
'Rename the new worksheet 
trg.Name = "Master" 
'Get column headers from the first worksheet 
'Column count first 
Set sht = wrk.Worksheets(1) 
colCount = sht.Cells(1, 255).End(xlToLeft).Column 
'Now retrieve headers, no copy&paste needed 
With trg.Cells(1, 1).Resize(1, colCount) 
    .Value = sht.Cells(1, 1).Resize(1, colCount).Value 
    'Set font as bold 
    .Font.Bold = True 
End With 

'We can start loop 
For Each sht In wrk.Worksheets 
    'If worksheet in loop is the last one, stop execution (it is Master worksheet) 
    If sht.Index = wrk.Worksheets.Count Then 
     Exit For 
    End If 
    'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets 
    Set rng = sht.Range(sht.Cells(2, 1), sht.Cells(65536, 1).End(xlUp).Resize(, colCount)) 
    'Put data into the Master worksheet 
    trg.Cells(65536, 1).End(xlUp).Offset(1).Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Formula 
Next sht 
'Fit the columns in Master worksheet 
trg.Columns.AutoFit 
Sheets("Master").Select 
colCount = Range("A" & Rows.Count).End(xlUp).Row 

Range("L2:L" & colCount).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 
'Screen updating should be activated 
Application.ScreenUpdating = True 

Sheets("Costing Sheet").Select 
End Sub 

Answer 1

코드의 목적은 워크 시트에 다른 워크 시트의 내용의 사본을 만들 것으로 보인다

"마스터 새 시트를 만드는 데 사용되는 코드입니다 도움을 수 있다면 큰 도움이 될 것입니다 ". 그것이 당신이 추구하는 것이라면이 코드는 당신의 요구 사항을 충족시킵니다. 빈 열 L이있는 행을 삭제하는 코드를 이해하지 못하고 단순히 주석 처리했습니다.

Option Explicit 
Sub CopyFromWorksheets() 

    Dim sht As Worksheet 
    Dim trg As Worksheet 
    Dim rng As Range 
    ' ## Long matches the natural size of an integer on a 32-bit computer. 
    ' ## A 16-bit Integer variable is, I am told, slightly slower in execution. 
    Dim colCount As Long 
    Dim rowCount As Long ' ## Added by me. See later. 
    Dim rowTrgNext As Long ' ## Added by me. See later. 

    ' ## The active workbook is the default workbook. You can have several 
    ' ## workbooks open and move data between them. If you were doing this 
    ' ## then identifying the required workbook would be necessary. In your 
    ' ## situation wrk has no value. You could argue it does no harm but I 
    ' ## dislike extra, unnecessary characters because I believe they make the 
    ' ## code harder to understand. I have remove all references to wrk. 

    For Each sht In Worksheets 
    If sht.Name = "Master" Then 
     MsgBox "There is a worksheet called as 'Master'." & vbCrLf & _ 
      "Please remove or rename this worksheet since 'Master' would be " & _ 
      "the name of the result worksheet of this process.", _ 
      vbOKOnly + vbExclamation, "Error" 
      Exit Sub 
    End If 
    Next sht 

    'Application.ScreenUpdating = False 
    Set trg = Worksheets.Add(After:=Worksheets(Worksheets.Count)) 
    'Rename the new worksheet 
    trg.Name = "Master" 
    'Get column headers from the first worksheet 
    'Column count first 
    Set sht = Worksheets(1) 
    ' ## 255 is the maximum number of columns for Excel 2003. 
    ' ## Columns.Count gives the maximum number of columns for any version. 
    colCount = sht.Cells(1, Columns.Count).End(xlToLeft).Column 
    'Now retrieve headers, no copy&paste needed 
    ' ## Excel VBA provides alternative ways of achieving the same result. 
    ' ## No doubt this is an accident of history but it is considered poor 
    ' ## language design. I avoid Resize and Offset (which you use later) 
    ' ## because I find the resultant statements difficult to get right in 
    ' ## the first place and difficult to understand when I need to update 
    ' ## the code six or twelve months later. I find .Range("Xn:Ym") or 
    ' ## .Range(.Cells(n, "X"),.Cells(m, "Y")) easier to get right and 
    ' ## easier to understand. I am not asking you to agree with me; I am 
    ' ## asking to consider what you would find easiest to get right and 
    ' ## easiest to understand when you look at this code in six months. 
    ' ## I have changed your code to show you the approach I prefer. 
    Set rng = sht.Range(sht.Cells(1, 1), sht.Cells(1, colCount)) 
    With trg 
    With .Range(.Cells(1, 1), .Cells(1, colCount)) 
     .Value = rng.Value 
     'Set font as bold 
     .Font.Bold = True 
    End With 
    End With 
    rowTrgNext = 2 ' ## See later 

    'We can start loop 
    For Each sht In Worksheets 
    'If worksheet in loop is the last one, stop execution 
    ' (it is Master worksheet) 
    ' ## I would favour 
    ' ## If sht.Name = "Master" Then 
    ' ## because think it is clearer. 
    If sht.Index = Worksheets.Count Then 
     Exit For 
    End If 
    ' ## 1) 65536 is the maximum number of rows for Excel 2003. 
    ' ## Rows.Count gives the maximum number of rows for any version. 
    ' ## 2) As explained earlier, I do not like Resize or Offset. 
    ' ## 3) I avoid doing more than one thing per statement if it means 
    ' ## I have to think hard about what is being achieved. 
    ' ## 4) Rather than use End(xlUp) to determine the last unused row in 
    ' ## worksheet Master, I maintain the value in rowTgtNext. 
    'Data range in worksheet - starts from second row as first rows are the header rows in all worksheets 
    With sht 
     ' ## Are you sure column A is full on every sheet 
     ' ## This returns the last row used regardless of column 
     rowCount = .Cells.SpecialCells(xlCellTypeLastCell).Row 
     Set rng = sht.Range(.Cells(2, 1), .Cells(rowCount, colCount)) 
    End With 
    'Put data into the Master worksheet 
    ' ## This copies everything: formulae, formats, etc. 
    rng.Copy Destination:=trg.Range("A" & rowTrgNext) 
    rowTrgNext = rowTrgNext + rowCount - 1 
    Next sht 
    'Fit the columns in Master worksheet 
    trg.Columns.AutoFit 

    ' ## I do not know what this is trying to achieve. 
    ' ## It will delete any row that does not have a value in column L 
    ' ## providing at least one cell in column L does contain a value. 
    'Sheets("Master").Select 
    'colCount = Range("A" & Rows.Count).End(xlUp).Row 
    'Range("L2:L" & colCount).SpecialCells(xlCellTypeBlanks).EntireRow.Delete 
    'Screen updating should be activated 

    Application.ScreenUpdating = True 
    Sheets("Costing Sheet").Select 

End Sub