从具有变量名称的文件复制数据

时间:2017-09-08 06:25:07

标签: excel vba excel-vba

我有3个文件,我从中复制数据,它们每个月都会出现,并且名称中始终具有相同的开头但结尾每月都会更改。我已经尝试过并试过但无处可去。

这样可行,但在这里我更改了名称只是为了使它工作,我也改变了文件的名称,仅用于此测试。

    Windows("Försäljningsdata Aktuell period.xlsx").Activate
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Datamatchningsfil Master.xlsm").Activate
Sheets("Försäljningsdata").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

下面你会看到日期,这个月会有所改变。尝试过*#但是没有得到它的支持。 8月也将每月更换一次,这个我可以改变,所以它来到201708,我认为这可以缓解一切。

Windows("Copy of CDPPT_KPI_2017.08-2017.08_43.xlsx").Activate
Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Windows("Datamatchningsfil Augusti.xlsm").Activate
Sheets("Försäljningsdata").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False

1 个答案:

答案 0 :(得分:0)

我建议为此任务使用一个函数,并删除所有不必要的.select。要调用该函数,您需要知道确切的文件名。

Public Sub DoActions()
    DoMyAction "Copy of CDPPT_KPI_2017.08-2017.08_43.xlsx", "Datamatchningsfil Augusti.xlsm"
End Sub


Public Function DoMyAction(SourceFile As String, DestinationFile As String)
    Dim wsSource As Worksheet
    Set wsSource = Workbooks(SourceFile).Worksheets(1) 'source is the first worksheet in the file

    With wsSource
        .Range(.Range("A2"), .Range("A2").End(xlToRight).End(xlDown)).Copy
    End With

    Workbooks(DestinationFile).Worksheets("Försäljningsdata").Range("A2").PasteSpecial _
       Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
End Function

要查找确切的文件名,例如使用FileDialogBox让用户选择一个文件(参见 How to get selected path and name of the file using open file dialog control)。

或者如果文件已在Excel中打开,那么您可以使用循环遍历所有工作簿来查找特定模式。

Public Sub ExampleToFindAWorkbookByPattern()
    Dim iWb As Workbook, FoundWb As Workbook
    For Each iWb In Workbooks 'loop throug all workbooks
        ' look if there is "2017.08" in it's name
        If InStr(1, iWb.Name, "2017.08") <> 0 Then
            Set FoundWb = iWb 'name was found, set workbook in FoundWb
            Exit Sub
        End If
    Next iWb

    'now you can use it e.g.
    DoMyAction FoundWb.Name, "Datamatchningsfil Augusti.xlsm"
End Sub