Kopiere Werte in einer Spalte von mehreren Arbeitsblättern in eins

Question

Das Problem ist das folgende: Ich habe eine Excel-Datei mit mehreren Arbeitsblättern und ich musste die G-Spalte von jedem Arbeitsblatt zu einem einzigen neuen Arbeitsblatt kopieren (die Spalten sollten neben sein einander oder mit einer leeren Spalte zwischen den Spalten mit Daten). Ich wollte auch fragen, ob es möglich ist, den Namen jedes Arbeitsblattes über die entsprechende Spalte zu setzen.

Bisher habe ich diesen Code:

Sub Copy_G_Columns() 
    Dim ws As Worksheet, i As Long 
    Application.ScreenUpdating = False 
    On Error Resume Next 
     Set ws = Sheets("Gee Columns") 
      If Err.Number <> 0 Then 
       ActiveWorkbook.Sheets.Add After:=ActiveWorkbook.Sheets(Sheets.Count): ActiveSheet.Name = "Gee Columns" 
        On Error GoTo 0 
       Else 
       Sheets("Gee Columns").Select 
      End If 

     For i = 1 To ActiveWorkbook.Sheets.Count - 1 
      With Sheets(i) 
        .Range("G1:G" & .Cells(.Rows.Count, 7).End(xlUp).Row).Copy Cells(2, i * 2 - 1) 
       Cells(1, i * 2 - 1) = Sheets(i).Name 
      End With 
     Next i 

    Application.ScreenUpdating = True 
End Sub 

Es scheint fast perfekt zu arbeiten. Das einzige Problem besteht darin, dass die Werte in den Spalten in dem neu erstellten Blatt einen # DIV/0-Fehler aufweisen. Ich denke, das Problem ist, dass der Code die Formate und nicht die Werte kopiert.

Answer 1

Hier ist meine Interpretation Ihres Codes.

Option Explicit 

Sub allGEE() 
    Dim w As Long, wsn As String, vGEEs As Variant 

    wsn = "Gee Columns" 

    For w = 1 To Worksheets.Count 
     With Worksheets(w) 
      On Error GoTo bm_NeedWorksheet 
      If .Name <> Worksheets(wsn).Name Then 
       On Error GoTo bm_Safe_Exit 
       vGEEs = .Range(.Cells(1, 7), .Cells(Rows.Count, 7).End(xlUp)).Value 
       vGEEs(1, 1) = .Name 
       With Worksheets(wsn).Cells(1, w * 2 - 1) 
        .Resize(UBound(vGEEs, 1), UBound(vGEEs, 2)) = vGEEs 
       End With 
      End If 
     End With 
    Next w 

    GoTo bm_Safe_Exit 

bm_NeedWorksheet: 
    On Error GoTo 0 
    With Worksheets.Add(after:=Sheets(Sheets.Count)) 
     .Name = wsn 
    End With 
    Resume 
bm_Safe_Exit: 
End Sub 

Ich habe die Staffelung in den Zielzellen beibehalten. Ich vermute stark, dass Sie Formeln über Kreuz kopiert haben und nur die Werte benötigt haben. Das Übertragen von Werten mit einem Varianten-Array (ohne Zwischenablage) ist schneller. Direkte Wertübertragung ist ebenfalls möglich, aber Sie wollten den Namen des Ursprungsarbeitsblatts in die erste (n) Zelle (n) eingeben.