首页 > 解决方案 > VBA:将数据从多张excel表复制到一个目标文件/表

问题描述

我正在尝试从特定 Excel 的多个工作表中复制数据并粘贴到主工作表中。我编写了以下代码;尽管它没有抛出任何错误,但它不会返回到主工作表(代码中的“DestFile”),也不会粘贴数据。在这里感谢任何支持。

Sub Monthly_Balance_Fetcher_Click()

Dim DestFile As Workbook, SourceFile As String, GetBook As String, SourceBook As String, myNum As Long, LatestDate As Long, SelectedDate As Long

LatestDate = Range("D1").Value

Set DestFile = ThisWorkbook 'ThisWorkbook is always the workbook that has the code (as opposed to ActiveWorkbook)
GetBook = ActiveWorkbook.Name

SourceFile = Application.GetOpenFilename(Title:="Please browse for the latest monthly TB file, prefer if you save it to your C first")
Workbooks.Open (SourceFile) 
SourceBook = ActiveWorkbook.Name
Sheets("Group").Select

myNum = Application.InputBox("Please enter the column number you want to copy from") 
Cells(3, myNum).Select
SelectedDate = Cells(3, myNum).Value

If SelectedDate > LatestDate Then


For i = 1 To totalsheets
    If Worksheets(i).Name <> "Summary" And Worksheets(i).Name <> "Process Steps" And Worksheets(i).Name <> "Sheet1" And Worksheets(i).Name <> "Adjustments" And Worksheets(i).Name <> "Targets" Then

    Worksheets(i).Activate

    Range(Cells(6, myNum)).Copy
    Range(Cells(13, myNum)).PasteSpecial Paste:=xlPasteValues

    DestFile.Activate

    lastrow = Cells(Rows.Count, 3).End(xlUp).Row

    Cells(lastrow + 1, 3) = Worksheets(i).Name
    Range(Cells("G" & lastrow + 1)).PasteSpecial Paste:=xlPasteValues
    Cells(lastrow + 1, 8) = SelectedDate

    End If
    Next

Else
MsgBox "Data from the selected date already exists! This macro will now stop", vbExclamation
DestFile.Activate
Cells(3, 5) = SelectedDate
Cells(2, 4) = LatestDate

End If

End Sub

标签: vbacopy

解决方案


推荐阅读