Скопируйте вставку с нескольких листов на один лист (требуется только несколько столбцов и установите автофильтр на консолидированном листе и разделите)

Question

У меня есть три листа (Sheet1, sheet2 и sheet5). Нужно скопировать из листа sheet1 столбцы "A", "B", "E", вставить в "Sheet5" c "," G "," H "и скопировать из sheet2столбец "J", "K", "N" вставьте в "Sheet5" c "," G "," H "(не следует перезаписывать) и в Sheet5 у меня есть первые три строки, мои заголовки, при этом следует вставить столбец Sheet5"G ", который имеет данные из sheet1 и sheet2: необходимо разделить, используя автофильтр только для конкретного текста" JOhn "," Alex "," france ". Имя отдельного листа должно быть" JOhn "," Alex "," france ".NeedВаша помощь в коде: я пробовал приведенный ниже код, который не работает по моему требованию и не могу редактировать из-за большего количества условий (я получил от Google) Sub copypaste () Dim lastrow As Integer, erow As Integer, sheet1 AsРабочий лист, лист2 Как набор рабочих листов sheet1 = Worksheets ("Sheet1") Set sheet2 = Worksheets ("Sheet2") lastrow = sheet1.Cells (Rows.Count, 1) .End (xlUp) .Row Для i = 2 To lastrow erow =sheet2.Cells (Rows.Count, 2) .End (xlUp) .Offset (1, 0) .Row sheet2.Cells (erow, 2) = sheet1.Cells (i, 3) sheet2.Cells (erow, 3) = sheet1.Cells (i, 6) sheet2.Cells (erow, 4) = sheet1.Cells (i, 9) Далее i End Sub

Answer 1

Sub CopyDataWithoutHeaders()
    Dim sh As Worksheet
    Dim DestSh As Worksheet
    Dim Last As Long
    Dim shLast As Long
    Dim CopyRng As Range
    Dim StartRow As Long

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    'Delete the sheet "RDBMergeSheet" if it exist
    Application.DisplayAlerts = False
    On Error Resume Next
    ActiveWorkbook.Worksheets("RDBMergeSheet").Delete
    On Error GoTo 0
    Application.DisplayAlerts = True

    'Add a worksheet with the name "RDBMergeSheet"
    Set DestSh = ActiveWorkbook.Worksheets.Add
    DestSh.Name = "RDBMergeSheet"

    'Fill in the start row
    StartRow = 2

    'loop through all worksheets and copy the data to the DestSh
    For Each sh In ActiveWorkbook.Worksheets
        If sh.Name <> DestSh.Name Then

            'Find the last row with data on the DestSh and sh
            Last = LastRow(DestSh)
            shLast = LastRow(sh)

            'If sh is not empty and if the last row >= StartRow copy the CopyRng
            If shLast > 0 And shLast >= StartRow Then

                'Set the range that you want to copy
                Set CopyRng = sh.Range(sh.Rows(StartRow), sh.Rows(shLast))

                'Test if there enough rows in the DestSh to copy all the data
                If Last + CopyRng.Rows.Count > DestSh.Rows.Count Then
                    MsgBox "There are not enough rows in the Destsh"
                    GoTo ExitTheSub
                End If

                'This example copies values/formats, if you only want to copy the
                'values or want to copy everything look below example 1 on this page
                CopyRng.Copy
                With DestSh.Cells(Last + 1, "A")
                    .PasteSpecial xlPasteValues
                    .PasteSpecial xlPasteFormats
                    Application.CutCopyMode = False
                End With

            End If

        End If
    Next

ExitTheSub:

    Application.Goto DestSh.Cells(1)

    'AutoFit the column width in the DestSh sheet
    DestSh.Columns.AutoFit

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Для получения более подробной информации см. Ссылку ниже.

https://www.rondebruin.nl/win/s3/win002.htm