将来自不同工作簿的粘贴数据复制到当前工作表

时间:2013-11-29 19:17:00

标签: excel vba excel-vba

我基本上被卡住了。我有一个允许我浏览文件的代码,一旦选择了文件,它就会复制该文件中的所有数据,然后允许我从当时打开的任何工作簿中选择一个工作表。一旦选择了工作表[这就是我被卡住的地方]我希望它将它粘贴到j7中。相反,它没有这样做,请记住,我将每天更改文件名,因为它具有当前的日期日期。 这是我的代码:

Sub Macro4()
'
' Macro4 Macro
'

'
Range("A1").Select
Dim fileStr As String

fileStr = Application.GetOpenFilename()

If fileStr = "False" Then Exit Sub

Workbooks.Open fileStr

Range("A2").Select
Range(Selection, Selection.End(xlToRight)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Window.Sheets(Array("Forecast_workings")).Select{**this is where i want to be able to select a worksheet from any open workbook and it will paste the data in cell J7 of that worksheet.**
Range("J7").Select
Application.CutCopyMode = False
Range("C16:C27").Select
Selection.Copy
Range("E16").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("G16:G27").Select
Selection.Copy
Range("C16").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Range("O16").Select
End Sub

2 个答案:

答案 0 :(得分:2)

我可以在你的代码中看到很多错误。

首先要做的事情。您可以避免使用.SelectINTERESTING READ

如果我理解正确,那么要获取用户在运行时选择的工作表的名称,您可以将Application.InputBoxType:=8一起使用。这将返回一个范围,您可以使用.Parent.Name获取工作表的名称。

这是你在尝试的吗?

您的代码可以写成( UNTESTED

Sub Macro4()
    Dim fileStr As String
    Dim wb As Workbook, thiswb As Workbook
    Dim ws  As Worksheet, thisws As Worksheet
    Dim Lcol As Long, LRow As Long
    Dim Ret As Range

    '~~> Set an object for thisworkbook and worksheet
    Set thiswb = ThisWorkbook
    '~~> Change this to the sheet from where you want to copy
    Set thisws = thiswb.Sheets("Sheet1")

    '~~> Let user choose a file
    fileStr = Application.GetOpenFilename()

    If fileStr = "False" Then Exit Sub

    '~~> Set an object for workbook opened and it's worksheet
    Set wb = Workbooks.Open(fileStr)

    On Error Resume Next
    Set Ret = Application.InputBox("Select a cell from the sheet you want to choose", Type:=8)
    On Error GoTo 0

    If Ret Is Nothing Then Exit Sub

    Set ws = wb.Sheets(Ret.Parent.Name)

    With thisws
        '~~> Find Last column in row 2
        Lcol = .Cells(2, .Columns.Count).End(xlToLeft).Column
        '~~> Find last cell in Col 1
        LRow = .Range("A" & .Rows.Count).End(xlUp).Row

        '~~> Copy your range directly to new worksheet selected
        .Range(.Cells(2, 1), .Cells(LRow, Lcol)).Copy ws.Range("J7")
        .Range("C16:C27").Copy ws.Range("E16")
        .Range("G16:G27").Copy ws.Range("C16")
        Application.CutCopyMode = False
    End With
End Sub

答案 1 :(得分:0)

使用多个工作簿时,不要使用range()但使用wb.range(),其中wb是使用set函数定义的。 活动表也可能很棘手。最好将您使用的纸张命名为纸张(“任何”)。 最后,复制东西不要使用activate / select,只需这样做:

wb.sheets("whatever").range() thisworkbook.sheets("watever2").range("").

我也看到你不使用application.enableevents = false / true,所以事件会像疯了一样触发,如果你在worksheet_change部分有代码,你的活动表(或单元格)就会变得疯狂。