Zeile mit Formel in Hauptblatt kopieren

Question

Ich habe eine Arbeitsmappe, in der wir unsere Angebotskosten berechnen. Es gibt ein Hauptblatt mit dem Namen "Kostenblatt" und einzelne Blätter, die unterschiedliche Namen haben können. Alle Blätter haben dasselbe Format wie Erste Zeile als Kopfzeile. Ich möchte nur ein Makro, das nach Werten in Spalte A in "Costing Sheet" sucht und mit den Werten in Spalte A anderer Blätter vergleicht. Wenn gefunden, kopieren Sie dann ganze Zeile A: W von einzelnen Blättern mit Formeln und formatieren nach "Costing Blatt "gegen den übereinstimmenden Wert. Ich habe ein Makro erstellt, das alle Daten kopiert und ein neues Blatt erstellt. aber das gibt mir nicht die gewünschte Ausgabe. Ich habe mehrere Foren durchsucht, konnte aber nicht dasselbe finden. Es wäre eine große Hilfe sein, wenn Sie helfen könnten METHIS der Code ich für die Schaffung eines neuen Blatt

erscheint

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

Ziel des Codes verwendet werden, eine Kopie von allen Inhalten aller anderen Arbeitsblättern in Arbeitsblatt „Master zu erstellen ". Wenn das ist, was Sie suchen, dann erfüllt dieser Code Ihre Anforderung. Ich verstehe den Code nicht, um eine Zeile mit einer leeren Spalte L zu löschen und habe sie einfach auskommentiert.

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