时间戳

首页 > 解决方案 > 将数据保存在一个文件中并在每次保存时将输出转到另一个文件

vba - 将数据保存在一个文件中并在每次保存时将输出转到另一个文件

问题描述

在一个选项卡中，我有信息，我已在第二个选项卡上输出信息（它比这更深入，但我尝试使其尽可能简单） 在此处输入图像描述 将此称为（1）

我想制作另一个文件，每次保存 (1) 时，(1) 的选项卡 2 中的信息都会在下面的 (2) 中叠加：

在此处输入图像描述 将此称为（2）

我猜这是基于宏的，但我不知道该怎么做。

为了澄清，有人第一次将数据保存到 (1) 中的选项卡 1 时，它的输出将发送到 (1) 中的选项卡 2。然后我希望将该数据保存到新文件 (2) 中，作为 XY Z。下次有人将数据保存在 (1) 中时，我希望它在新文件 (2) 中弹出为 AB C。因此，每次保存文件时，都会在新文件上形成新的数据，(2)。

OP提供的代码（取自评论）：

Private Sub CommandButton21_Click() 
    Dim Name As String 
    Dim Date As String 
    Dim State As String 
    Worksheets("Sheet1").Select FileName = Range("B1") 
    EffectiveDate = Range("B2") 
    State = Range("B3") 
    Set myData = Workbooks.Open("H: \NameDateState.xlsx") 
    Worksheets("Sheet1").Select 
    Worksheets("sheet1").Range("A1").Select 
    RowCount = Worksheets("sheet1").Range("A1").CurrentRegion.Rows.Count 
    With Worksheets("Sheet1")
        .Range("A1") .Offset(RowCount, 0) = Name 
        .Offset(RowCount, 1) = Date 
        .Offset(RowCount, 2) = State 
    End With 
    myData.Save 
End Sub

标签： vbaexcelloops

解决方案

让我们看看我们能做什么...您希望将数据从 Sheets(1) 移动到选项卡 Sheets(2)，然后您希望将 Sheets(2) 移动到一个新文件并保存该文件（可能已关闭）。

如果是这种情况，您将需要做几件事，从长远来看，其中一些可能有助于您的编码：

  • 1) 尽可能避免使用 .Select/.Activate

  • 2）在您开始列出子例程之前，在模块顶部使用 Option Explicit（将强制您声明所有变量）

让我们进一步分解您的问题...您在 Sheets(1) 上有一个指定位置来输入数据，这些数据将（通过单击按钮）输入到 Sheets(2)。我们假设您的标题位于第 1 列（“A”），输入位于第 2 列（“B”）：

dim lrd as long
With Sheets(2)
    lrd = .cells(.rows.count,1).end(xlup).row
    .Cells(lrd+1,1).Value = Sheets(1).cells(1,2).Value  'Date
    .Cells(lrd+1,2).Value = Sheets(1).cells(2,2).Value  'State
    .Cells(lrd+1,3).Value = Sheets(1).cells(3,2).Value  '# People
    'You will probably want to clear data from the input cells after that
    Sheets(1).Range(Sheets(1).Cells(1,2),Sheets(1).Cells(3,2)).ClearContents
End With

好的，数据现在存在于 Sheets(2) 中。您现在希望将 Sheets(2) 复制到 .Copy （将工作表放入新工作簿）：

Sheets(2).Copy

然后 SaveAs 新工作簿，然后保存/关闭：

ActiveWorkbook.SaveAs "C:\NameOfFile.xlsx", FileFormat:=51
ActiveWorkbook.Close SaveChanges:=True

这应该会让您打开一个输入工作簿。尽管我提供了一个固定的情况，但我建议根据更动态的方式对文件进行一些命名。请注意，您的源文件将是 xlsm，保存为 xlsx 将从新工作簿中删除宏，以防有任何东西被转移。

总而言之，它看起来像：

dim lrd as long
With Sheets(2)
    lrd = .cells(.rows.count,1).end(xlup).row
    .Cells(lrd+1,1).Value = Sheets(1).cells(1,2).Value  'Date
    .Cells(lrd+1,2).Value = Sheets(1).cells(2,2).Value  'State
    .Cells(lrd+1,3).Value = Sheets(1).cells(3,2).Value  '# People
    'You will probably want to clear data from the input cells after that
    Sheets(1).Range(Sheets(1).Cells(1,2),Sheets(1).Cells(3,2)).ClearContents
End With
Sheets(2).Copy
ActiveWorkbook.SaveAs "C:\NameOfFile.xlsx", FileFormat:=51
ActiveWorkbook.Close SaveChanges:=True

推荐阅读