В VBA скопируйте все данные листа на определенный лист в другой книге

Question

Пожалуйста, помогите.Смотрю на это и ищу сайты 2 дня.У меня есть файл, который является сводным файлом "mysumwb".Я открываю все файлы в папке.«LsWb» представляет открытый файл.Поиск определенного листа с именем "LsFileSh."и скопируйте / вставьте значение всего листа "LsFileSh" в последний лист в файле сводки.На самом деле происходит копирование листа на ALL листов в файле назначения / сводки "mysumwb".

Вот код.Извините за все комментарии.И спасибо.

 Sub Summarize_Reports()
'Mar 18, 2019
On Error Resume Next

Const shN = "Sheet Format"                               '<< summary workbook sheet name
Const LsFileSh = "1. Summary for Reporting "             '<< summary workbook sheet name

Dim wb As Workbook
Set mysumwb = ThisWorkbook                               '<< The summary WB
Dim SumWs As Worksheet
Set SumWs = ThisWorkbook.Sheets(shN)                     '<< The summary workbook sheet, "Summary Format"


Dim CountSh As Long, r As Long, c As Long
Dim A As Long
Dim myPath As String
Dim myFile As String
Dim LsWb As Workbook        '<< This is the leasing file WB identifierDim fldr As FileDialog
Dim LsFileName As String

Application.ScreenUpdating = False

'***********************************This With statement selects the folder

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Please select the folder where the Capital lease files are, then press OK to continue"
.AllowMultiSelect = False
    If .Show <> -1 Then
    Set fldr = Nothing
    Else
    myPath = .SelectedItems(1)
    End If

    If Right(myPath, 1) <> "\" Then
    myPath = myPath & "\"
    End If
End With

myFile = Dir(myPath & "*capital*.xl*")

'MsgBox mysumwb.Name
'MsgBox mysumwb.Worksheets.Count
CountSh = mysumwb.Worksheets.Count
'MsgBox CountSh

Do While myFile <> ""


    Sheets("Summary Format").Select                      '<<<<<< copy the tab in the sumwp file
    Sheets("Summary Format").Copy After:=Sheets(CountSh)

    'mysumwb.SumWs.Select
    'mysumwb.SumWs.Copy After:=mysumwb.workheets(CountSh)

    Set LsWb = Workbooks.Open(myPath & myFile)           '<<< establish the open leasing file's name
    LsFileName = Left(LsWb.Name, Len(LsWb.Name) - 4)     '<<< move the filename to a string
    mysumwb.Sheets(CountSh + 1).Name = LsFileName

    LsWb.Sheets(LsFileSh).Activate
 '   LsWb.Sheets(LsFileSh).Cells.Copy
 '   mysumwb.Sheets(Worksheets.Count).Cells.Value = LsWb.Sheets(LsFileSh).Cells.Value

    With mysumwb

        CountSh = mysumwb.Worksheets.Count
        MsgBox CountSh
        .Sheets(CountSh).Name = LsFileName
        .Sheets(LsFileName).Activate
        .Sheets(LsFileName).Range("A1").PasteSpecial Paste:=xlPasteValues
        MsgBox LsFileName
    End With

'    MsgBox ActiveWorkbook.Name
'    mysumwb.Sheets(LsFileName).Select
'    MsgBox ActiveWorkbook.Worksheets(CountSh + 1).Name
'
'
'
'    mysumwb.Sheets(LsFileName).Range("A1").PasteSpecial Paste:=xlPasteValues


    Application.CutCopyMode = False


    LsWb.Close False
    myFile = Dir()
    mysumwb.Save
Loop


ActiveWorkbook.Save
Application.ScreenUpdating = True
NoFilesProcessed.Value = "Lease Files Processed = " & A
MsgBox A
MsgBox "All Done!"


On Error GoTo 0
End Sub

Answer 1

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

Sub Summarize_Reports()
'Mar 18, 2019


Const shN = "Sheet Format"                               '<< summary workbook sheet name
Const LsFileSh = "1. Summary for Reporting "             '<< summary workbook sheet name

Dim wb As Workbook
Set MySumWb = ActiveWorkbook                               '<< The summary WB
Dim SumWs As Worksheet
Set SumWs = ActiveWorkbook.Sheets(shN)                     '<< The summary workbook sheet, "Summary Format"


Dim CountSh As Long, r As Long, c As Long
Dim A As Long
Dim myPath As String
Dim myFile As String
Dim LsWb As Workbook        '<< This is the leasing file WB identifierDim fldr As FileDialog
Dim LsFileName As String

Application.ScreenUpdating = False

'***********************************This With statement selects the folder

Set fldr = Application.FileDialog(msoFileDialogFolderPicker)
With fldr
.Title = "Please select the folder where the Capital lease files are, then press OK to continue"
.AllowMultiSelect = False
    If .Show <> -1 Then
    Set fldr = Nothing
    Else
    myPath = .SelectedItems(1)
    End If

    If Right(myPath, 1) <> "\" Then
    myPath = myPath & "\"
    End If
End With

myFile = Dir(myPath & "*capital*.xl*")

'MsgBox mysumwb.Name
'MsgBox mysumwb.Worksheets.Count
CountSh = MySumWb.Worksheets.Count
'MsgBox CountSh

Do While myFile <> ""


    MySumWb.Worksheets("Summary Format").Select                      '<<<<<< copy the tab in the sumwp file
    MySumWb.Worksheets("Summary Format").Copy After:=Sheets(CountSh)

    'mysumwb.SumWs.Select
    'mysumwb.SumWs.Copy After:=mysumwb.workheets(CountSh)

    Set LsWb = Workbooks.Open(myPath & myFile)           '<<< establish the open leasing file's name
    LsFileName = Left(LsWb.Name, Len(LsWb.Name) - 4)     '<<< move the filename to a string
    MySumWb.Sheets(CountSh + 1).Name = LsFileName

    LsWb.Sheets(LsFileSh).Activate
    LsWb.Sheets(LsFileSh).Cells.Copy

    MySumWb.Sheets(LsFileName).Range("A1").PasteSpecial Paste:=xlPasteValues



'    MsgBox ActiveWorkbook.Name
'    mysumwb.Sheets(LsFileName).Select
'    MsgBox ActiveWorkbook.Worksheets(CountSh + 1).Name
'
'
'
'    mysumwb.Sheets(LsFileName).Range("A1").PasteSpecial Paste:=xlPasteValues


    Application.CutCopyMode = False


    LsWb.Close False
    myFile = Dir()
    MySumWb.Save
Loop


ActiveWorkbook.Save
Application.ScreenUpdating = True
MsgBox A
MsgBox "All Done!"



End Sub