Копирование данных с разными столбцами и именами листов из нескольких книг — VBA

Привет, я пытался найти возможные решения для моего вопроса, но я не могу найти точный код, который мне нужен.

Мне нужно скопировать данные из двух разных книг с разными именами листов, а также с разными столбцами. Я использовал свой код при копировании данных из одной книги, но есть ошибка, говорящая

«Ошибка автоматики».

Итак, что мне нужно сделать, это скопировать данные с имен листов Raw Data и Arm Checklist на мой основной рабочий лист, также названный Raw Data.

Столбцы, которые мне нужно скопировать из Raw Data, из A7:Q, а в Arm Checklist из C3:D,G,E,H:J,K,M:Q. Данные из этих столбцов необходимо объединить с моим MainWorkfile Raw Data

Sub SAMPLE()        
    Dim MainWorkfile As Workbook
    Dim OtherWorkfile As Workbook
    Dim OtherWorkfile2 As Workbook
    Dim TrackerSht As Worksheet
    Dim FilterSht As Worksheet
    Dim FilterSht2 As Worksheet

    Dim lRow As Long, lRw As Long

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    ' set workbook object
    Set MainWorkfile = ActiveWorkbook

    ' set the worksheet object
    Set TrackerSht = MainWorkfile.Sheets("Raw Data")
    With TrackerSht
        lRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"
        .Range("A7:S7" & lRow).ClearContents
    End With


    Application.AskToUpdateLinks = False

    ' set the 2nd workbook object
    Set OtherWorkfile = Workbooks.Open(Filename:=Application.GetOpenFilename)

    ' set the 2nd worksheet object
    Set FilterSht = OtherWorkfile.Sheets("Raw Data")

    With FilterSht
        If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
        lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

        .Range("A7:Q" & lRw).Copy ' copy your range
    End With

    ' paste
    TrackerSht.Range("A7:Q" & lRow).PasteSpecial Paste:=xlPasteValues, _
                    Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    OtherWorkfile.Close

    Set OtherWorkfile2 = Workbooks.Open(Filename:=Application.GetOpenFilename)

    ' set the 2nd worksheet object
    Set FilterSht2 = OtherWorkfile.Sheets("Arm Checklist")

    With FilterSht2
        If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
        lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

        .Range("C3:D" & lRw).Copy ' copy your range
    End With

    ' paste
    TrackerSht.Range("A:B" & lRow).PasteSpecial Paste:=xlPasteValues, _
                    Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    ' implement it for the rest of your columns...
    With FilterSht2
        If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
        lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

        .Range("G3:G" & lRw).Copy ' copy your range
    End With

    ' paste
    TrackerSht.Range("C7:C" & lRow).PasteSpecial Paste:=xlPasteValues, _
                    Operation:=xlNone, SkipBlanks:=False, Transpose:=False


    With FilterSht2
        If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
        lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

        .Range("E3:E" & lRw).Copy ' copy your range
    End With

    ' paste
    TrackerSht.Range("E7:E" & lRow).PasteSpecial Paste:=xlPasteValues, _
                    Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    With FilterSht2
        If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
        lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

        .Range("H3:J" & lRw).Copy ' copy your range
    End With

    ' paste
    TrackerSht.Range("F7:H" & lRow).PasteSpecial Paste:=xlPasteValues, _
                    Operation:=xlNone, SkipBlanks:=False, Transpose:=False

    OtherWorkfile2.Close



End Sub

aicirtap 06.07.2018 источник

comment

Где вы берете свою ошибку? В какой строке? Используйте отладчик. - Kajkrow 06.07.2018

comment

Я получил ошибку, когда попытался добавить этот код Set OtherWorkfile2 = Workbooks.Open(Filename:=Application.GetOpenFilename) для моей второй книги, чтобы выбрать и скопировать необходимые данные, но я думаю, что vba не может прочитать этот вид кода. - aicirtap 06.07.2018

comment

Я только что попробовал код, и эта строка отлично работает для меня. Я думаю, это другая линия. Вы прошли шаг за шагом через свой код? - Kajkrow 06.07.2018

comment

Я нашел твою ошибку. Он находится в Line Set FilterSht2 = OtherWorkfile.Sheets(Контрольный список Arm). Отредактируйте его, чтобы установить FilterSht2 = OtherWorkfile2.Sheets (контрольный список Arm), и он должен работать. - Kajkrow 06.07.2018

comment

Также измените строку TrackerSht.Range(A:B & lRow).PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False на TrackerSht.Range(A1:B & lRow).PasteSpecial Paste :=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False. - Kajkrow 06.07.2018

comment

И вы должны добавить Application.ScreenUpdating = True и Application.DisplayAlerts = True и Application.AskToUpdateLinks = True в конце вашего кода, поскольку он остается ложным и могут возникнуть проблемы. - Kajkrow 06.07.2018

comment

@Kajkrow хорошо, я сначала попробую и дам вам отзыв. - aicirtap 06.07.2018

comment

@Kajkrow он работает, но вторая рабочая книга, которую нужно скопировать, не копируется в мой основной рабочий файл. Я не знаю, как я могу добавить его после того, как данные были скопированы из первой книги. Возможно, эта часть моего кода неверна TrackerSht.Range(A1:B & lRow).PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False, потому что она перекрывает первые скопированные данные к этому диапазону. - aicirtap 06.07.2018

comment

Честно говоря, я не совсем понимаю, в чем ваша проблема, но я думаю, вам нужно настроить начальную точку: TrackerSht.Range(A7:B & lRow).PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:= Ложь, транспонирование:=ложь - Kajkrow 06.07.2018

comment

Привет @Kajkrow, моя проблема в том, что я точно не знаю код, который мне нужно использовать, потому что скопированные данные перекрываются с первыми данными. Вот сценарий, о котором я говорю, первые данные поступают из необработанных данных, которые будут скопированы после того, как следующий контрольный список будет скопирован, но код делает перекрытие данных из необработанных данных в контрольный список. Надеюсь, вы можете мне помочь. Спасибо - aicirtap 06.07.2018

comment

Поэтому все, что вам нужно сделать, это настроить значения диапазона. если ваши данные перекрывают хотя бы один диапазон, это неправильно. чтобы настроить диапазоны, вам нужно изменить значения TrackerSht.Range( & lRow) Внутри кавычек вы должны поместить диапазон, например. Е7:Е, А7:Б. Эти диапазоны должны быть скорректированы. Я не могу сделать это за вас, потому что я не знаю, куда вы хотите поместить какие данные. - Kajkrow 06.07.2018

comment

Могу ли я сделать это автоматически? или использовать lastrow? потому что данные не всегда имеют один и тот же объем, поэтому, если я установлю диапазон TrackerSht.Range(A20:B & lRow), тогда данные из первой книги будут больше 20, они будут перекрываться. - aicirtap 06.07.2018

comment

как насчет этого: добавьте dim lstrow as long в начало вашего кода. затем измените свой TrackerSht.Range(A20:B & lRow) на TrackerSht.Range(A & lstRow & :B & lRow) и включите перед каждым из этих утверждений lstRow = TrackerSht.Cells(.Rows.Count, A).End( xlUp).Row не проверял, но может работать. - Kajkrow 06.07.2018

comment

Давайте продолжим обсуждение в чате. - aicirtap 06.07.2018

Ответы (2)

arrow_upward
1
arrow_downward

Эй, вот моя попытка решить вашу проблему:

Sub conso()

Dim MainWorkfile As Workbook
Dim myFiles As Variant
Dim fso As Scripting.FileSystemObject
Set fso = New Scripting.FileSystemObject
Dim OtherWorkfile(1 To 2) As Workbook
Dim CorrectionHandler(1 To 2) As Workbook
Dim TrackerSht As Worksheet
Dim FilterSht As Worksheet

Dim i As Integer

Dim lRow As Long, lRw As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False

' set workbook object
Set MainWorkfile = ThisWorkbook

' set the worksheet object
Set TrackerSht = MainWorkfile.Sheets("Raw Data")
With TrackerSht
    lRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 ' last row with data in column "C"
End With

On Error GoTo ErrHand

TryAgain:
myFiles = Application.GetOpenFilename(MultiSelect:=True)

If UBound(OtherWorkfile) > 2 Then
    MsgBox "Too many WBs selected"
    GoTo TryAgain
End If

For i = LBound(myFiles) To UBound(myFiles)
    Set OtherWorkfile(i) = Workbooks.Open(myFiles(i))
Next i
'Set OtherWorkfile = Workbooks.Open(Filename:=Application.GetOpenFilename())
'currentPath = Application.ActiveWorkbook.Path
'Set OtherWorkfile = Workbooks.Open(currentPath & "\OtherWB2.xls")


On Error GoTo correction
GoTo jumper
correction:
Set CorrectionHandler(2) = OtherWorkfile(1)
Set CorrectionHandler(1) = OtherWorkfile(2)
Set OtherWorkfile(1) = CorrectionHandler(1)
Set OtherWorkfile(2) = CorrectionHandler(2)
On Error GoTo ErrHand
jumper:

' set the 2nd worksheet object
Set FilterSht = OtherWorkfile(1).Sheets("Arm Checklist")

On Error GoTo ErrHand

With FilterSht
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("C3:D" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("A7:B" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False

' implement it for the rest of your columns...
With FilterSht
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("G3:G" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("C7:C" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False


With FilterSht
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("E3:E" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("E7:E" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False

With FilterSht
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("H3:J" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("F7:H" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False


With FilterSht
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("K3:K" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("L7:L" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False

With FilterSht
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("M3:Q" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("M7:Q" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False

OtherWorkfile(1).Close
'----------------------------2nd Workbook-------------------------------------

With TrackerSht
    lRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 ' last row with data in column "C"
End With


Application.AskToUpdateLinks = False

'Set OtherWorkfile = Workbooks.Open(Filename:=Application.GetOpenFilename)
'currentPath = Application.ActiveWorkbook.Path
'Set OtherWorkfile = Workbooks.Open(currentPath & "\OtherWB.xls")
Set FilterSht = OtherWorkfile(2).Sheets("Raw Data")

With FilterSht
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("A7:Q" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("A" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False

OtherWorkfile(2).Close

ErrHand:

    If Err.Number = 1004 Then                    'could use 1004 here

        MsgBox "You Choose to Cancel"
        Err.Clear
    Else
        Debug.Print Err.Description

    End If


Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True

End Sub

Как видите, теперь все в 1 саб. Можно разделить его на 2 сабвуфера, что не имеет особого смысла, так как вам всегда придется использовать оба сабвуфера. (потому что вторая подпрограмма будет называться так: call conso2(otherworkfile(2)) поэтому вы не можете использовать вторую подпрограмму без inputvar.

Kajkrow 13.07.2018

comment

Я только что еще раз просмотрел код и нашел несколько незначительных ошибок. Я исправил их. - Kajkrow; 16.07.2018

arrow_upward
0
arrow_downward

Вот код, который я придумал, если у кого-нибудь есть другая идея о том, как я могу выбрать свои рабочие книги как одну, потому что сейчас, когда я запускаю ее, «Workbooks.Open (Filename: = Application.GetOpenFilename)» мне нужно выбрать дважды чтобы я мог выбрать две книги, которые мне нужно объединить.

Sub conso1()

Dim MainWorkfile As Workbook
Dim OtherWorkfile2 As Workbook
Dim TrackerSht As Worksheet
Dim FilterSht2 As Worksheet

Dim lRow As Long, lRw As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

' set workbook object
Set MainWorkfile = ActiveWorkbook

' set the worksheet object
Set TrackerSht = MainWorkfile.Sheets("Raw Data")
With TrackerSht
    lRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 ' last row with data in column "C"
End With


Application.AskToUpdateLinks = False


On Error GoTo ErrHand:
'Set OtherWorkfile2 = Workbooks.Open(Filename:=Application.GetOpenFilename)
currentPath = Application.ActiveWorkbook.Path
Set OtherWorkfile2 = Workbooks.Open(currentPath & "\OtherWB2.xls")

' set the 2nd worksheet object
Set FilterSht2 = OtherWorkfile2.Sheets("Arm Checklist")


With FilterSht2
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("C3:D" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("A7:B" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False

' implement it for the rest of your columns...
With FilterSht2
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("G3:G" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("C7:C" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False


With FilterSht2
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("E3:E" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("E7:E" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False

With FilterSht2
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("H3:J" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("F7:H" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False


With FilterSht2
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("K3:K" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("L7:L" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False

With FilterSht2
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("M3:Q" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("M7:Q" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False

OtherWorkfile2.Close

ErrHand:

    If Err.Number = 1004 Then                    'could use 1004 here

        MsgBox "You Choose to Cancel"
        Err.clear
    Else
        Debug.Print Err.Description

    End If


Call conso2

End Sub


Sub conso2()

Dim MainWorkfile As Workbook
Dim OtherWorkfile As Workbook
Dim TrackerSht As Worksheet
Dim FilterSht As Worksheet

Dim lRow As Long, lRw As Long

Application.ScreenUpdating = False
Application.DisplayAlerts = False

' set workbook object
Set MainWorkfile = ActiveWorkbook

' set the worksheet object
Set TrackerSht = MainWorkfile.Sheets("Raw Data")
With TrackerSht
    lRow = .Cells(.Rows.Count, "A").End(xlUp).Row + 1 ' last row with data in column "C"
End With


Application.AskToUpdateLinks = False

On Error GoTo ErrHand:
'Set OtherWorkfile = Workbooks.Open(Filename:=Application.GetOpenFilename)
currentPath = Application.ActiveWorkbook.Path
Set OtherWorkfile = Workbooks.Open(currentPath & "\OtherWB.xls")
Set FilterSht = OtherWorkfile.Sheets("Raw Data")

With FilterSht
    If .FilterMode Or .AutoFilterMode Then .AutoFilterMode = False
    lRw = .Cells(.Rows.Count, "A").End(xlUp).Row ' last row with data in column "C"

    .Range("A7:Q" & lRw).Copy ' copy your range
End With

' paste
TrackerSht.Range("A" & lRow).PasteSpecial Paste:=xlPasteValues, _
                Operation:=xlNone, SkipBlanks:=False, Transpose:=False


OtherWorkfile.Close

ErrHand:

    If Err.Number = 1004 Then                    'could use 1004 here

        MsgBox "You Choose to Cancel"
        Err.clear
    Else
        Debug.Print Err.Description

    End If


End Sub

aicirtap 06.07.2018

comment

чтобы автоматически выбрать книгу, вы можете жестко указать путь или, если wbs находятся в той же папке, что и wb, из которого вы запускаете макрос, вы можете использовать currentPath = Application.ActiveWorkbook.Path для пути, а затем добавить \XXX.xlsx для согласно вбс. - Kajkrow; 06.07.2018

comment

@Kajkrow, вы можете научить меня, как я могу реализовать этот currentPath в своих кодах? Спасибо. - aicirtap; 09.07.2018

comment

Я внес изменения в ваш ответ. он должен работать. вам нужно точное имя файла (замените OtherWB(2)) и окончание файла (xls/xlsm). - Kajkrow; 09.07.2018

comment

привет @Kajkrow вопрос, могу ли я использовать Workbooks.Open(Filename:=Application.GetOpenFilename), чтобы выбрать эти две книги, которые мне нужны? - aicirtap; 12.07.2018

comment

ну это то, что у вас было раньше. вот почему это тоже работает. Но я думал, вы хотели избежать ручного выбора рабочих тетрадей. - Kajkrow; 12.07.2018

comment

о... кажется, теперь я понял. Вы хотите выбрать только одну книгу по любому пути, а 2-й ББ находится в той же папке, но вы не хотите снова выбирать путь. это правильно? скажи мне, ошибаюсь я или нет, и я покажу тебе решение. - Kajkrow; 12.07.2018

comment

Привет @Kajkrow Мне нужно выбрать две книги одновременно, используя Workbooks.Open(Filename:=Application.GetOpenFilename), ваше первое решение в порядке, но каждый раз, когда мне нужно передать необработанный файл, мне также нужно изменить имя файла потому что всегда есть изменения в необработанном имени файла. Не могли бы вы мне помочь? - aicirtap; 13.07.2018

comment

насколько я знаю, вы не можете выбрать два файла одновременно через workbooks.open. Дай мне подумать об этом. Я мог бы предложить решение. - Kajkrow; 13.07.2018

comment

@Kajkrow Большое спасибо за вашу помощь, я свяжусь с вами для вашего решения, пока я не ищу, как я могу это сделать. - aicirtap; 13.07.2018

comment

поэтому я нашел эту тему: stackoverflow .com/questions/25180061/ . так что можно выбрать несколько, но у вас есть массив, который вам нужно обрабатывать. поскольку вы используете 2 разных сабвуфера, необходим другой обходной путь, или ваши 2 сабвуфера должны быть 1 сабвуфером. Я поработаю над этим и дам вам ответ. - Kajkrow; 13.07.2018

Копирование данных с разными столбцами и именами листов из нескольких книг — VBA

Ответы (2)

Вопросы по теме