在一个工作簿中选择多个工作表，将内容粘贴复制到一个主表中 [英] Multiple selection of worksheets into one workbook copy paste of content into one main sheet

问题描述

如果在我的工作簿中选择了多个excel文件并将其复制粘贴到称为源"的工作表中，那么我在这里想要实现的目标.但是，尽管我导入的第一个文件可以正常工作，但是第二个文件不会在我最后使用的行之后粘贴.怎么了?

What i am trying here to achieve if multiple selection of excel files into my workbook and copy paste the content into the sheet called "Source". But although the first file i import works correctly the second one does not paste after my last used row. What is wrong with it?

Sub Import()

'Clear previous Front Page sheet & error report information
Sheets("Source").Cells.clearcontents
Sheets("Source").Cells.ClearFormats

On Error GoTo ErrHandler

'Seek the file to be imported

Set fd = Application.FileDialog(msoFileDialogFilePicker)
Set wbb = ThisWorkbook
Set sh = wbb.Worksheets("Source")

With fd
    .Title = "Please select the early correction file to be imported"
    .AllowMultiSelect = True
    Err.Clear
    FileChosen = fd.Show
    If MsgBox("Files selected, continue?", vbYesNo) = vbNo Then Exit Sub

    If FileChosen = -1 Then
        For i = 1 To fd.SelectedItems.Count
            file = fd.SelectedItems(i)
            Workbooks.Open Filename:=file, ReadOnly:=True
            If file = "" Then Exit Sub
            filesheet = "Template"
            Sheets(filesheet).Cells.COPY
            LastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
            Sheets("Source").Range("A" & LastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
            'Workbooks(file).Close savechanges:=False
        Next i
    End If
End With

Exit Sub

ErrHandler:

If MsgBox("ERROR: " & Err.Description & vbCrLf & "Do you want to Continue...?", vbExclamation + vbYesNo, "Error") = vbYes Then
    Resume Next
End If

推荐答案

LastRow方法存在一些错误.它现在应该可以正常工作，至少对我有用.

There was a little error with the LastRow method. It should work now, at least it does for me.

Sub Import()
Dim fnMine
Dim firsTime As Boolean
'Clear previous Front Page sheet & error report information
Sheets("Source").Cells.ClearContents
Sheets("Source").Cells.ClearFormats

On Error GoTo ErrHandler
'Seek the file to be imported

Set fd = Application.FileDialog(msoFileDialogFilePicker)
Set wbb = ThisWorkbook
Set sh = wbb.Worksheets("Source")
firsTime = True

With fd
    .Title = "Please select the early correction file to be imported"
    .AllowMultiSelect = True
    Err.Clear
    FileChosen = fd.Show
    If MsgBox("Files selected, continue?", vbYesNo) = vbNo Then Exit Sub

    If FileChosen = -1 Then
        For i = 1 To fd.SelectedItems.Count
            file = fd.SelectedItems(i)
            Workbooks.Open Filename:=file, ReadOnly:=True
            fnMine = Split(file, "\")
            fnMine = fnMine(UBound(fnMine))
            If file = "" Then Exit Sub
            filesheet = "Template"
            Sheets(filesheet).Select
            ActiveSheet.UsedRange.Select
            Selection.Copy
            If firsTime = True Then
                LastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row
                firsTime = False
            Else
                LastRow = sh.Cells(sh.Rows.Count, "A").End(xlUp).Row + 1
            End If

            wbb.Activate
             Sheets("Source").Range("A" & LastRow).PasteSpecial Paste:=xlPasteValues
            Workbooks(fnMine).Close savechanges:=False
        Next i
    End If
End With


Exit Sub

ErrHandler:

If MsgBox("ERROR: " & Err.Description & vbCrLf & "Do you want to Continue...?", vbExclamation + vbYesNo, "Error") = vbYes Then
    Resume Next
End If
End Sub

这篇关于在一个工作簿中选择多个工作表，将内容粘贴复制到一个主表中的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！