vba selection.copy 导致 selection.pastespecial 不起作用。优秀的VBA

Question

提问by PCGIZMO

I will keep this quick. The attached code for the most part works i have used slight variations of it on other projects. the commented out range3.copy is from my last project.

我会保持这个快速。大部分工作的附加代码我在其他项目中使用了它的轻微变化。注释掉的 range3.copy 来自我的上一个项目。

I am currently having issues getting selection.copy to copy the selected range in the correct workbook. I have tried many things some are noted in the script. but I can not get the selection.copy to work .range.copy will work and populate the clipboard. But I have not figured out how to pastespecial using .copy.

我目前在获取 selection.copy 以在正确的工作簿中复制所选范围时遇到问题。我尝试了许多脚本中提到的一些内容。但我无法让 selection.copy 工作 .range.copy 将工作并填充剪贴板。但我还没有弄清楚如何使用 .copy 粘贴特殊的。

I tried outputting to variable .. didn't work as i thought it might. I feel I have to be missing something on the workbook selection/activation but I don't know what. Thanks in advance for any advice or assistance .. I will continue plugging away and see if I can figure it out.

我尝试输出到变量 .. 没有像我想象的那样工作。我觉得我必须在工作簿选择/激活中遗漏一些东西，但我不知道是什么。提前感谢您的任何建议或帮助..我会继续努力，看看我能不能弄明白。

Here is the first segment with the issue. SRCrange1.select then selection.copy does not actually copy the designated selection. The full code is below.

这是问题的第一部分。SRCrange1.select then selection.copy 实际上并不复制指定的选择。完整代码如下。

      Dim MyColumn As String
    Dim Here As String
    Dim AC As Variant

     'SRCrange1.copy  ': This will copy to clipboard

       'objworkbook.Worksheets("plan").Range("b6:h7").Select  no change from SRCrange1.select
       'SRCrange1.Select 'the range does select
        'Selection.copy  '  this will cause a activecell in DSTwb _
        to be copied neither direct reference to SRCrange1.select or .avtivate will change that.


DSTwb.Select
             DSTwb.Range("b2").Select
             Here = ActiveCell.Address
             MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)
             Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)
             lastrow.Select
             Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True

FULL CODE

完整代码

Sub parse()
Dim strPath As String
Dim strPathused As String


'On Error Resume Next


Set objexcel = CreateObject("Excel.Application")
objexcel.Visible = True
objexcel.DisplayAlerts = False
strPath = "C:\prodplan"
Set objfso = CreateObject("Scripting.FileSystemObject")
Set objFolder = objfso.GetFolder(strPath)


'Loop through objWorkBooks
For Each objfile In objFolder.Files

    If objfso.GetExtensionName(objfile.Path) = "xlsx" Then
        Set objworkbook = objexcel.Workbooks.Open(objfile.Path)
                                ' Set path for move to at end of script
                                strPathused = "C:\prodplan\used\" & objworkbook.Name

'open WB to consolidate too
                        Workbooks.Open "C:\prodplan\compiled\plancon.xlsx"

'Range management sourcebook
        Set SRCwb = objworkbook.Worksheets("plan")
        Set SRCrange1 = objworkbook.Worksheets("plan").Range("b6:i7")
        Set SRCrange2 = objworkbook.Worksheets("plan").Range("k6:p7")
        'Set SRCrange3 = objworkbook.Worksheets("").Range("")

'Range management sourcebook
        Set DSTwb = Workbooks("plancon.xlsx").Worksheets("data")
        'Set DSTrange1 = Workbooks("plancon.xlsx").Worksheets("data").Range("")
        'Set DSTrange2 = Workbooks("plancon.xlsx").Worksheets("data").Range("")
        'Set DSTrange3 = Workbooks("plancon.xlsx").Worksheets("data").Range("")

'start header dates and shifts copy from objworkbook to consolidated WB
                SRCwb.Select
                'On Error Resume Next
                'SRCwb.Cells.UnMerge

Dim MyColumn As String
Dim Here As String
Dim AC As Variant

 'SRCrange1.copy  ': This will copy to clipboard

   'objworkbook.Worksheets("plan").Range("b6:h7").Select  no change from SRCrange1.select
   'SRCrange1.Select 'the range does select
    'Selection.copy  '  this will cause a activecell in DSTwb _
    to be copied neither direct reference to SRCrange1.select or .avtivate will change that.
         DSTwb.Select
         DSTwb.Range("b2").Select
         Here = ActiveCell.Address
         MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)
         Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)
         lastrow.Select
         Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True


   SRCrange2.Select
    Selection.copy
         Workbooks("plancon.xlsx").Worksheets("sheet1").Select
         ActiveSheet.Range("b2").Select
         ActiveSheet.Range("b2").Activate
         Here = ActiveCell.Address
         MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)
         Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)
         lastrow.Select
         Selection.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True

'    range3.copy
'         Workbooks("data.xlsx").Worksheets("sheet1").Activate
'         ActiveSheet.Range("c2").Select
'         ActiveSheet.Range("c2").Activate
'         Here = ActiveCell.Address
'         MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)
'         Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)
'         ActiveSheet.Paste Destination:=lastrow


                    'start loop for objworkbook name copy to field in plancon corisponding with date/shift and copy/paste select row data.

    objworkbook.Close False
                        'Move proccesed file to new Dir

    OldFilePath = objfile 'original file location
        NewFilePath = strPathused ' new file location
            Name OldFilePath As NewFilePath ' move the file

End If

Next

objexcel.Quit




End Sub

Answer 1

回答by Scott Holtzman

First, a relative welcome to SO!

一、亲戚欢迎SO！

Second, some tips for you that will make life easier in VBA programming:

其次，给你一些让 VBA 编程更轻松的技巧：

Use Option Explicit and always Dimension and Declare your variable types.
When naming variables, make them easy to understand and follow. So, if you are going to create a worksheet variable, call it something like wksCopy. Or, if you are going to name a workbook, call it wkbCopyTo
You don't need to use .Select and .Activate, but rather you can work directly with your objects. Also, by declaring the appropriate variables types, this make it much easier to work with these objects in your code each time you need them.
I don't know if you are running this code inside Excel, or another application (like Access), but if you are in Excel, there is no need to create an Excel object, as you can work with the Excel App directly. Ignore this if you are using Access / Word / PPT etc to fire the code.

使用 Option Explicit 并始终使用 Dimension 和 Declare 您的变量类型。
命名变量时，要使它们易于理解和遵循。因此，如果您要创建工作表变量，请将其命名为 wksCopy。或者，如果您要命名工作簿，请将其命名为 wkbCopyTo
您不需要使用 .Select 和 .Activate，而是可以直接使用您的对象。此外，通过声明适当的变量类型，可以在每次需要时更轻松地在代码中使用这些对象。
我不知道您是在 Excel 还是其他应用程序（如 Access）中运行此代码，但如果您在 Excel 中，则无需创建 Excel 对象，因为您可以直接使用 Excel 应用程序。如果您使用 Access / Word / PPT 等来触发代码，请忽略此项。

All these tips make your code much easier to read and understand and follow when trying to debug, and write.

所有这些技巧使您的代码在尝试调试和编写时更易于阅读、理解和遵循。

All that said, I have refactored your code above to incorporate most of these principles (I kept all your variable names intact so you wouldn't get lost in any re-namings.) If this re-write doesn't directly solve your problem = which it may not, because the code is kind of confusing to me as written, I think it will be much easier for you to follow and understand and find out where it's not doing what you expect when you debug. Also, I think it will help us help you if you can't figure it out.

综上所述，我已经重构了您上面的代码以包含其中的大部分原则（我保留了您所有的变量名称，这样您就不会在任何重命名中迷失方向。）如果这种重写不能直接解决您的问题= 它可能不是，因为代码在编写时对我来说有点混乱，我认为您可以更轻松地遵循和理解并找出调试时它没有按照您的预期执行。另外，我认为如果您无法弄清楚，它会帮助我们帮助您。

Sub parse()

    Dim strPath As String, strPathused As String
    Dim objexcel As Excel.Application

    Set objexcel = CreateObject("Excel.Application")
    With objexcel
        .Visible = True
        .DisplayAlerts = False
    End With

    strPath = "C:\prodplan"

    Dim objfso As FileSystemObject, objFolder As Folder

    Set objfso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objfso.GetFolder(strPath)


    'Loop through objWorkBooks
    For Each objfile In objFolder.Files

        If objfso.GetExtensionName(objfile.Path) = "xlsx" Then

            Dim objWorkbook As Excel.Workbook
            Set objWorkbook = objexcel.Workbooks.Open(objfile.Path)

            ' Set path for move to at end of script
            strPathused = "C:\prodplan\used\" & objWorkbook.Name

            'open WB to consolidate too
            objexcel.Workbooks.Open "C:\prodplan\compiled\plancon.xlsx"

            'Range management sourcebook
            Dim SRCwb As Excel.Worksheet, SRCrange1 As Excel.Range, SRCrange2 As Excel.Range

            Set SRCwb = objWorkbook.Worksheets("plan") 'sjh -> to me wb implies wb, but you set it to a worksheet (could be a style thing, but worth pointing out
            Set SRCrange1 = objWorkbook.Worksheets("plan").Range("b6:i7")
            Set SRCrange2 = objWorkbook.Worksheets("plan").Range("k6:p7")


            'Range management sourcebook
            Set DSTwb = Excel.Worksheet
            Set DSTwb = Workbooks("plancon.xlsx").Worksheets("data")

            'start header dates and shifts copy from objworkbook to consolidated WB
            Dim MyColumn As String
            Dim Here As String
            Dim AC As Variant

            Here = DSTwb.Range("B2").Address
            MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)

            'sjh comment -> best to change "ActiveWorkbook" to the workbook referece you mean, like objWorkbook
            Dim lastrow As Range
            Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)

            SRCrange1.Copy
            lastrow.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True

            Here = Workbooks("plancon.xlsx").Worksheets("sheet1").Range("B2").Address
            MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)


            'sjh comment -> best to change "ActiveWorkbook" to the workbook referece you mean, like objWorkbook
            Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)

            SRCrange2.Copy
            lastrow.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True

            objWorkbook.Close False

            'Move proccesed file to new Dir

            OldFilePath = objfile 'original file location
            NewFilePath = strPathused ' new file location
            Name OldFilePath As NewFilePath ' move the file

        End If

    Next

objexcel.Quit

End Sub

UPDATEIf you are running this all in Excel. Just use this code below. I left both codes in my answer, in case you are not running this from Excel.

更新如果您在 Excel 中运行这一切。只需使用下面的代码。我在答案中留下了两个代码，以防您不是从 Excel 运行它。

Option Explicit

Sub parse()

    Application.DisplayAlerts = False

    Dim strPath As String, strPathused As String
    strPath = "C:\prodplan"

    Dim objfso As FileSystemObject, objFolder As Folder

    Set objfso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objfso.GetFolder(strPath)


    'Loop through objWorkBooks
    For Each objfile In objFolder.Files

        If objfso.GetExtensionName(objfile.Path) = "xlsx" Then

            Dim objWorkbook As Workbook
            Set objWorkbook = Workbooks.Open(objfile.Path)

            ' Set path for move to at end of script
            strPathused = "C:\prodplan\used\" & objWorkbook.Name

            'open WB to consolidate too
            Workbooks.Open "C:\prodplan\compiled\plancon.xlsx"

            'Range management sourcebook
            Dim SRCwb As Worksheet, SRCrange1 As Range, SRCrange2 As Range

            Set SRCwb = objWorkbook.Worksheets("plan")
            Set SRCrange1 = SRCwb.Range("b6:i7")
            Set SRCrange2 = SRCwb.Range("k6:p7")

            'Range management sourcebook
            Dim DSTwb As Worksheet
            Set DSTwb = Workbooks("plancon.xlsx").Worksheets("data")

            'start header dates and shifts copy from objworkbook to consolidated WB
            Dim MyColumn As String
            Dim Here As String
            Dim AC As Variant

            Here = DSTwb.Range("B2").Address
            MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)

           'sjh comment -> best to change "ActiveWorkbook" to the workbook referece you mean, like objWorkbook or the other workbook you have open
            Dim lastrow As Range
            Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)

            SRCrange1.Copy
            lastrow.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True

            Here = Workbooks("plancon.xlsx").Worksheets("sheet1").Range("B2").Address
            MyColumn = Mid(Here, InStr(Here, "$") + 1, InStr(2, Here, "$") - 2)

           'sjh comment -> best to change "ActiveWorkbook" to the workbook referece you mean, like objWorkbook or the other workbook you have open
            Set lastrow = ActiveWorkbook.ActiveSheet.Range(MyColumn & "65536").End(xlUp).Offset(1, 0)

            SRCrange2.Copy
            lastrow.PasteSpecial Paste:=xlPasteValues, operation:=xlNone, skipblanks:=False, Transpose:=True

            objWorkbook.Close False

            'Move proccesed file to new Dir

            OldFilePath = objfile 'original file location
            NewFilePath = strPathused ' new file location
            Name OldFilePath As NewFilePath ' move the file

        End If

    Next

End Sub

Answer 2

回答by Tim Williams

Just to add to the other answers: for contiguous ranges you don't need to use copy for this operation (pastespecial >> values + transpose)

只是为了添加其他答案：对于连续范围，您不需要为此操作使用复制（pastespecial >> values + transpose）

Sub CopyValuesTranspose()

    Dim rngCopy As Range, rngPaste As Range

    Set rngCopy = Range("A1:B10")
    Set rngPaste = Range("D1")

    rngPaste.Resize(rngCopy.Columns.Count, rngCopy.Rows.Count).Value = _
                                   Application.Transpose(rngCopy.Value)

End Sub

Answer 3

回答by Aprillion

no need to select a range and then copy the selection, when you can copy a range directly:

无需选择范围然后复制选择，当您可以直接复制范围时：

objworkbook.Worksheets("plan").Range("b6:h7").Copy
same_or_different_Range.PasteSpecial Paste:=xlPasteValues, _
    operation:=xlNone, skipblanks:=False, Transpose:=True

vba selection.copy 导致 selection.pastespecial 不起作用。优秀的VBA

提问by PCGIZMO

回答by Scott Holtzman

回答by Tim Williams

回答by Aprillion

相关推荐

最近更新

标签

vba selection.copy 导致 selection.pastespecial 不起作用。优秀的VBA

提问by PCGIZMO

回答by Scott Holtzman

回答by Tim Williams

回答by Aprillion

相关推荐

vba 如何从命令行启动 Excel 宏（没有 Worksheet_Open 事件）？

在 VBA 宏中使用符号 #（哈希）

使用 VBA 在单元格中查找字符串

vba 获取上次插入记录的 ID - Access DAO、ODBC、SQL Server 2008 标识字段

相关推荐

最近更新

标签