Question

冗长的标题，但希望我能解释一下。我想要做的是将活动工作簿中的值复制/粘贴到与活动状态相同的目录“文件夹”中包含的另一个工作簿中。我需要复制的范围是动态的，如果我在当前范围中添加行，我希望代码自动选择它，而不必手动修改代码中的范围。

我设法在StackOverflow上找到了一些代码，这些代码执行了我需要的静态内容，但我不知道如何添加各种“动态”需求，因为我的VBA知识遗憾的是不够先进。如果你能够提供帮助，非常感谢！

代码：

Public Sub CopyData()
Dim x As Workbook
Dim y As Workbook
Dim vals As Variant
Dim RemoveRows

下面是我需要动态新工作簿的“路径”。我想也许沿着Application.ActiveWorkbook.Path的路线找到路径，正如我以前见过的那样，但我无法让它真正起作用。然后还需要添加目标工作簿的文件扩展名，我已在活动工作簿的单元格F2中的“工作表1”上指定。即，如果有意义，打开的目标工作簿将是“ActiveWorkbook.Path + Sheet 1 cell F2 + .xls”。单元格F2的原因是我可以将此代码与其他工作簿名称一起使用。

'Open workbook first:
Set x = Workbooks.Open("PATH")

继续完成代码。

Set y = ThisWorkbook

低于Range我需要也是动态的，理想情况下它会在A列（从第4行开始）中查找，并为所有列AP创建一个复制/存储范围，直到第一个空白单元位于A（即完全如下所示，但如果我在A栏中添加另外2行文本，则13会自动增加到15。

'Store values in a variable:
vals = y.Sheets("Sheet1").Range("A4:P13").Value

继续通过代码（粘贴/变量赋值需要与上面的val完全相同，但偏移量增加2，即如果添加行则应为A2到P11或P13。）

'Use the variable to assign a value to the other file/sheet:
x.Sheets("Sheet2").Range("A2:P11").Value = vals

'Delete Zero Rows
Set x = ActiveWorkbook
x.Sheets("Sheet2").Activate
For RemoveRows = Range("K65536").End(xlUp).Row To 1 Step -1
   If Cells(RemoveRows, 11).Value = 0 Then Rows(RemoveRows).EntireRow.Delete

Next RemoveRows

'Copy Paste Values Again to Sheet 1 to ensure formatting uncompromised
vals = x.Sheets("Sheet2").Range("A2:P1000").Value
x.Sheets("Sheet1").Range("A2:P1000").Value = vals
x.Sheets("Sheet2").Cells.Clear
x.Sheets("Sheet1").Activate

'Close x:
If x.Saved = False Then
    x.Save
End If
x.Close

End Sub

Answer 1

关于路径的第一个问题，你几乎就在那里，你只需要构建完整的字符串。 Application.activeworkbook.path返回指向activeworkbook目录的字符串，因此您只需要添加文件名

对于动态范围，您可以使用Range.End属性

对于工作表/书籍之间的转换，我建议使用Range.Copy / paste属性。粘贴范围时，您只需指定左上角的单元格，excel将负责其余的

我做了一些更新，以使工作表引用更明确，避免.activate，以及其他一些更改，但类似下面的内容应该这样做：

Public Sub CopyData()
    Dim x As Workbook
    Dim y As Workbook
    Dim xWs1 As Worksheet
    Dim xWs2 As Worksheet
    Dim yWs As Worksheet
    Dim vals As Range
    Dim newVals As Range
    Dim RemoveRows
    Dim Path As String

    'build the Path
    Path = Application.ActiveWorkbook.Path & "\file.xlsx" 'as an alternative you could use the Application.FileDialog(msoFileDialogOpen) to promt the user to select the file

    'Open workbook first:
    Set x = Workbooks.Open(Path)
    Set xWs1 = x.Sheets("Sheet1")
    Set xWs2 = x.Sheets("Sheet2")

    Set y = ThisWorkbook
    Set yWs = y.Sheets("Sheet1")

    'reference values by a range:
    Set vals = yWs.Range("A4:P" & yWs.Range("A4").End(xlDown).Row)
    'copy/paste the range other file/sheet:
    vals.Copy xWs2.Range("A2")



    'Delete Zero Rows
    For RemoveRows = xWs2.Range("A2").End(xlDown).Row To 2 Step -1
        If xWs2.Cells(RemoveRows, 11).Value = 0 Then
            xWs2.Rows(RemoveRows).EntireRow.Delete
        End If
    Next RemoveRows

    'Copy Paste Values Again to Sheet 1 to ensure formatting uncompromised
    Set newVals = xWs2.Range("A2:P" & xWs2.Cells(1048576, 1).End(xlUp).Row)
    newVals.Copy xWs1.Range("A2")
    xWs2.Rows.EntireRow.Delete
    xWs1.Activate

    'Close x:
    If x.Saved = False Then
        x.Save
    End If
    x.Close

End Sub

VBA将具有动态范围的值复制/粘贴到另一个工作簿中，包括动态文件路径查找

1 个答案: