Объединение листов Excel с помощью VBA

Если вам нужен более точный ответ, вам нужно сначала попробовать что-то, а затем попросить помощи в том месте, где вы застряли. Я предлагаю вам начать с; 1. Начните писать сценарий VBA в OG.XLS, в качестве первого шага попробуйте получить доступ к файлу A.xls, прочитать столбцы и вставить их (изначально они могут быть в любом месте в любом порядке). 2. Как только вы сможете это сделать, следующим шагом будет проверка, поместите ли вы данные в правый столбец (скажем, 5000 в вашем примере), установив правильный тип переменных, используя их и увеличивая их. 3. Следующим шагом должно стать чтение заголовков столбцов в A.XLS, поиск их OG.XLS и их идентификация. Первоначально вы можете начать с простого сравнения строк, позже вы можете уточнить это, чтобы выполнить ВПР. 4. В ходе этого процесса, если вы столкнетесь с какой-либо конкретной проблемой, поднимите ее, чтобы получить лучший ответ.

Немногие из сообщества пойдут на то, чтобы написать для вас весь код.

Почему столбец A попадает в столбец F, а C - в столбце T? Есть ли такое правило, например, что первая строка - это заголовок с таким же текстом?

Может быть, картинка может помочь.

Исходя из того, что я могу догадаться, я бы бросил каждый лист в RecordSet со значимыми именами полей (вам нужно будет указать Microsoft ActiveX Data Objects 2.8 Library). После этого будет очень легко добавить каждый RecordSet и выбросить их на один лист.

Чтобы сделать это аккуратно, вам нужно будет найти последний столбец и последнюю строку на каждом листе, поэтому взгляните на Как мне найти последнюю строку ....

Редактировать...

Ниже приведен очищенный пример того, как вы могли бы делать то, что вам нужно, в VBA. Дьявол кроется в деталях, таких как пустые листы, и в том, как обрабатывать формулы (это полностью игнорирует их), и в том, как правильно объединить столбцы (снова игнорируется).

Это было проверено в Excel 2007.

Option Explicit
Const MAX_CHARS = 1200



Sub MergeAllSheets()
  Dim rs As Recordset
  Dim mergedRS As Recordset
  Dim sh As Worksheet
  Dim wb As Workbook

  Dim fieldList As New Collection
  Dim rsetList As New Collection

  Dim f As Variant
  Dim cols As Long
  Dim rows As Long
  Dim c As Long
  Dim r As Long

  Dim ref As String
  Dim fldName As String
  Dim sourceColumn As String



  Set wb = ActiveWorkbook
  For Each sh In wb.Worksheets
    Set rs = New Recordset
    ref = FindEndCell(sh)
    cols = sh.Range(ref).Column
    rows = sh.Range(ref).Row

    If ref <> "$A$1" Or sh.Range(ref).Value <> "" Then '' This is to catch empty sheet
      c = 1
      r = 1
      Do While c <= cols
        fldName = sh.Cells(r, c).Value
        rs.Fields.Append fldName, adVarChar, MAX_CHARS
        If Not InCollection(fieldList, fldName) Then
          fieldList.Add fldName, fldName
        End If
        c = c + 1
      Loop
      rs.Open


      r = 2
      Do While r <= rows
        rs.AddNew
        c = 1
        Do While c <= cols
          rs.Fields(c - 1) = CStr(sh.Cells(r, c).Value)
          c = c + 1
        Loop
        r = r + 1
        Debug.Print sh.Name & ": " & r & " of " & rows & ", " & c & " of " & cols
      Loop
      rsetList.Add rs, sh.Name
    End If
  Next


  Set mergedRS = New Recordset
  c = 1
  sourceColumn = "SourceSheet"
  Do While InCollection(fieldList, sourceColumn) '' Just in case you merge a merged sheet
    sourceColumn = "SourceSheet" & c
    c = c + 1
  Loop
  mergedRS.Fields.Append sourceColumn, adVarChar, MAX_CHARS
  For Each f In fieldList
    mergedRS.Fields.Append CStr(f), adVarChar, MAX_CHARS
  Next
  mergedRS.Open

  c = 1
  For Each rs In rsetList
    If rs.RecordCount >= 1 Then
      rs.MoveFirst
      Do Until rs.EOF
        mergedRS.AddNew
        mergedRS.Fields(sourceColumn) = "Sheet No. " & c
        For Each f In rs.Fields
          mergedRS.Fields(f.Name) = f.Value
        Next
        rs.MoveNext
      Loop
    End If
    c = c + 1
  Next


  Set sh = wb.Worksheets.Add

  mergedRS.MoveFirst
  r = 1
  c = 1
  For Each f In mergedRS.Fields
    sh.Cells(r, c).Formula = f.Name
    c = c + 1
  Next

  r = 2
  Do Until mergedRS.EOF
    c = 1
    For Each f In mergedRS.Fields
      sh.Cells(r, c).Value = f.Value
      c = c + 1
    Next
    r = r + 1
    mergedRS.MoveNext
  Loop
End Sub

Public Function InCollection(col As Collection, key As String) As Boolean
  Dim var As Variant
  Dim errNumber As Long

  InCollection = False
  Set var = Nothing

  Err.Clear
  On Error Resume Next
    var = col.Item(key)
    errNumber = CLng(Err.Number)
  On Error GoTo 0

  '5 is not in, 0 and 438 represent incollection
  If errNumber = 5 Then ' it is 5 if not in collection
    InCollection = False
  Else
    InCollection = True
  End If

End Function


Public Function FindEndCell(sh As Worksheet) As String
  Dim cols As Long
  Dim rows As Long
  Dim maxCols As Long
  Dim maxRows As Long
  Dim c As Long
  Dim r As Long

  maxRows = sh.rows.Count
  maxCols = sh.Columns.Count

  cols = sh.Range("A1").End(xlToRight).Column
  If cols >= maxCols Then
      cols = 1
  End If


  c = 1
  Do While c <= cols

    r = sh.Cells(1, c).End(xlDown).Row
    If r >= maxRows Then
      r = 1
    End If

    If r > rows Then
      rows = r
    End If
    c = c + 1
  Loop

  FindEndCell = sh.Cells(rows, cols).Address

End Function