时间戳

首页 > 解决方案 > VBa代码打开关闭的文件并复制列工作但什么也没做

excel - VBa代码打开关闭的文件并复制列工作但什么也没做

问题描述

我有一个代码应该打开输入文件并从那里复制一些特定的列。这个宏没有显示任何错误它的工作但没有发生任何事情，我没有看到任何动作。我有 Excel 2016

Sub btnExport_Click()
Dim strPath As String
Dim wbMe, wb As Workbook

strPath = selectFile
If strPath = "" Then Exit Sub

Set wbMe = ActiveWorkbook

Set wb = Workbooks.Open(strPath, False, True)
wb.Sheets(1).Columns("A:C").Copy Destination:=wbMe.Sheets(1).Range("A1")
wb.Sheets(1).Columns("H").Copy Destination:=wbMe.Sheets(1).Range("D1")

wb.Close False
Set wb = Nothing

Beep
MsgBox "The data was imported"
End Sub
Private Function selectFile()
Dim fd As Office.FileDialog

Set fd = Application.FileDialog(3)


With fd
.InitialFileName = ActiveWorkbook.Path
.AllowMultiSelect = False
.Title = "Please select file to import."
.Filters.Clear
.Filters.Add "Excel", "*.xlsm"

If Show = True Then selectFile = .SelectedItems(1)

End With
End Function

标签： excelvba

解决方案

这是在您的工作表模块中：

Option Explicit

Sub btnExport_Click()
Dim strPath As String
Dim wbMe As Workbook, wb As Workbook

strPath = selectFile

If strPath = "" Then Exit Sub

Set wbMe = ActiveWorkbook
Set wb = Workbooks.Open(strPath, False, True)

copyRangeValues wb.Sheets(1).Columns("A:C"), wbMe.Sheets(1).Range("A1")
copyRangeValues wb.Sheets(1).Columns("H"), wbMe.Sheets(1).Range("D1")

wb.Close False
Set wb = Nothing

Beep
MsgBox "The data was imported"
End Sub

如果您还没有，请在您的项目中添加一个模块。

将以下函数粘贴到该模块

Option explicit

Public Function selectFile()

Dim fd As Office.FileDialog
Set fd = Application.FileDialog(3)

With fd
    .InitialFileName = ActiveWorkbook.Path
    .AllowMultiSelect = False
    .Title = "Please select file to import."
    .Filters.Clear
    .Filters.Add "Excel", "*.xlsm"
    
    If Show = True Then selectFile = .SelectedItems(1)
End With

End Function


Public Sub copyRangeValues(rgSource As Range, rgTargetCell As Range)
'generic routine to copy one range to another
'rgTargetCell = top left corner of target range

Dim rgTarget As Range
'resize rgTarget according to dimensions of rgSource
With rgSource
    Set rgTarget = rgTargetCell.Resize(.Rows.Count, .Columns.Count)
End With


'write values from rgSource to rgTarget - no copy/paste necessary!!!
'formats are not copied - only values
rgTarget.value = rgSource.value

End Sub

推荐阅读