Excel VBA将具有选定列和行的两个文件合并到一个基于其标题的工作表中

我两周前被老板指派了一份工作。它使用VBA Excel创建宏，将两个不同的excelxls文件合并到一个标题工作表中

这是给定标题的工作表

[用户名]，[姓名]，[尝试]，[开始日期]，[分数]，[奎兹詹-23-2013]，[完成]

这是给出的两个文件

1.CWPI专题1评估

1行编号[用户名]，[姓名]，[尝试]，[开始日期]，[分数]，[QuizJan-23-2013]

2行编号[11111111]，[Matt]，[0000002]，[2013]，[00100]，[UUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUUU

2.CWPI专题1

1行编号[用户名]，[姓名]，[尝试]，[开始日期]，[分数]，[完成]

2行编号[123456789]，[Rose]，[0000001]，[2013]，[00080]，[Completed]

上面的两个文件没有特定位置

我需要选择两个文件与选定的列和最后一行和传输数据根据标题。因为其中一个包含不同的头。 但必须确保它收集最后一行数据。因为有时可能是1000行数据有时可能是2000行数据。。。 最后，我需要删除副本 我一直在寻找各种各样的解决方案，包括getfile、vlookup、copy&paste。我只是有点困惑。如有任何建议或解决方案，将不胜感激>请尝试：

Sub GetFile()

Dim Book1Path As Variant, Book2Path As Variant
Dim SourceWB As Workbook, DestWB As Workbook
Dim lRow As Long

'## Open both workbook first:

Book1Path = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="CWPI Topic 1 Assessment")
If Book1Path = False Then Exit Sub
Set Source = Workbooks.Open(Book1Path)

Book2Path = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="CWPI Topic 1")
If Book2Path = False Then Exit Sub
Set DestWB = Workbooks.Open(Book2Path)

'Turn off screen updating and alerts.
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

'Copy.
With SourceWB.Sheets("Report")
    lRow = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("A2:G" & lRow).Copy
End With

'Paste.
DestWB.Sheets("Sheet1").Range("A2").PasteSpecial xlPasteAll
SourceWB.Close

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

End Sub

---

让我们知道这是否有帮助。

您能告诉我们到目前为止您做了哪些尝试吗？你说你一直在寻找各种各样的解决方案。很高兴看到你的尝试刚刚更新了我的代码，很抱歉更新太晚。您好，谢谢您的代码。每一页的最后一列是什么？是G列吗？还是这个变量也是？这是因为我们必须使其具有灵活性。我已经看到你的最后一篇专栏文章是[测验…或[已完成…是否正确？我的最后一列是H。我只需要选择并复制整行数据，直到G列。但最后一行数据可能会有所不同。对于最后一列H，我需要复制并粘贴到另一列。非常感谢>如果Book2Path=False，则退出Sub。对于此代码，它显示类型不匹配。很抱歉，我对vb有点陌生a exel>已更新上述内容。请重试。

               A         B      C        D       E          F         

Sub GetFile()

Dim fNameAndPath As Variant
Dim copywb As Workbook
Dim destinationwb As Workbook

'## Open both workbook first:

fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="CWPI Topic 1 Assessment")

If fNameAndPath = False Then Exit Sub

Set copywb = Workbooks.Open(fNameAndPath)

fNameAndPath = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS",    Title:="CWPI Topic 1 Assessment")
If fNameAndPath = False Then Exit Sub
Set destinationwb = Workbooks.Open(fNameAndPath)

'Now, copy what you want from copywb:
copywb.Sheets("Report").Range("A1:G2").Copy
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

'Now, paste to destinationwb worksheet:
destinationwb.Sheets("Sheet1").Range("A2").PasteSpecial

'Close copywb:
Application.DisplayAlerts = False
Application.DisplayAlerts = True
ActiveWorkbook.Close False
copywb.Close 
End Sub

copywb.Sheets("Report").Range("A1:G2").Copy  
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy

Sub GetFile()

Dim Book1Path As Variant, Book2Path As Variant
Dim SourceWB As Workbook, DestWB As Workbook
Dim lRow As Long

'## Open both workbook first:

Book1Path = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="CWPI Topic 1 Assessment")
If Book1Path = False Then Exit Sub
Set Source = Workbooks.Open(Book1Path)

Book2Path = Application.GetOpenFilename(FileFilter:="Excel Files (*.XLS), *.XLS", Title:="CWPI Topic 1")
If Book2Path = False Then Exit Sub
Set DestWB = Workbooks.Open(Book2Path)

'Turn off screen updating and alerts.
With Application
    .ScreenUpdating = False
    .DisplayAlerts = False
End With

'Copy.
With SourceWB.Sheets("Report")
    lRow = .Cells(Rows.Count, 1).End(xlUp).Row
    .Range("A2:G" & lRow).Copy
End With

'Paste.
DestWB.Sheets("Sheet1").Range("A2").PasteSpecial xlPasteAll
SourceWB.Close

With Application
    .ScreenUpdating = True
    .DisplayAlerts = True
End With

End Sub