Birden çok çalışma sayfasındaki bir sütundaki değerleri bir

Question

olarak kopyalayın Sorun şu şekildedir: Birden çok çalışma sayfası içeren bir excel dosyası var ve G sütununu her çalışma sayfasından tek bir yeni çalışma sayfasına kopyalamam gerekiyordu (sütunların yanında olması gerekir) birbiriyle veya veri içeren sütunlar arasında boş bir sütunla). Ayrıca her çalışma sayfasının ismini karşılık gelen kolonun üzerine koymak mümkün olup olmadığını sormak istedim.

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 

Neredeyse mükemmel iş gibi görünüyor:

Şu ana kadar, bu kodu kullandım. Tek sorun, yeni oluşturulan sayfada, sütunlardaki değerlerin bir # DIV/0 hatası olmasıdır. Problemin kodun formatları değil, değerleri kopyaladığını düşünüyorum.

Answer 1

İşte kodunuzu yorumlamıyorum.

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 

Hedef hücrelerde stagger'ı korudum. Formülleri kopyaladığınızdan ve yalnızca değerlere ihtiyaç duyduğunuzdan şüpheleniyorum. Varyant dizisiyle (pano olmadan) değerleri aktarmak daha hızlıdır. Doğrudan değer transferi de mümkündür, ancak başlangıç ​​çalışma sayfası adını ilk hücreye yerleştirmek istediniz.