将单元格中的单元格复制到多个工作簿中

时间:2015-09-12 15:25:37

标签: excel vba excel-vba

我在同一个文件夹中有大约300个工作簿,我想将单个B19-B49从1个工作簿复制到同一文件夹中的300个工作簿的其余部分。这有可能以一些聪明的方式,所以我不必复制粘贴300个不同的文件?

祝你好运

3 个答案:

答案 0 :(得分:0)

使用简单的PowerShell脚本将源文件中的值复制到目标目录中的文件。只需用您的值替换顶部的5个变量:

$sourceFile = "c:\tmp\source.xlsx"
$destinationDirectory = "c:\tmp"
$sheetName = "Sheet1"
$rangeToCopyStart = "B19"
$rangeToCopyEnd = "B49"

#----------------------------------------------
# Open Excel source file
#----------------------------------------------

$excelApplication = New-Object -comobject Excel.Application                        
$excelWorkbook = $excelApplication.Workbooks.Open($sourceFile, 2, $True)
$excelWorksheet = $excelWorkbook.Worksheets.Item($sheetName)            

#----------------------------------------------
# Copy the cell value 
#----------------------------------------------

"Value to copy:" + $excelWorksheet.Range($rangeToCopyStart, $rangeToCopyEnd).Value2;
"From:" + $sourceFile;
$excelWorksheet.Range($rangeToCopyStart, $rangeToCopyEnd).Copy() | out-null;
$excelWorkbook.Close();                                                

#----------------------------------------------
# Get all Excel files from destination directory 
#----------------------------------------------

$Files = Get-ChildItem $destinationDirectory -Filter *.xlsx

Foreach ($Item in $Files) {

    $destinationFile = $Item.FullName

    #----------------------------------------------
    # Skip the source file if it's in the same directory 
    #----------------------------------------------


    If ($sourceFile.ToLower() -eq $destinationFile.ToLower())  { continue; }  

    $destinationWorkbook = $excelApplication.Workbooks.Open($destinationFile, 2, $False)       
    $destinationWorkSheet = $destinationWorkbook.Worksheets.Item($sheetName)                 

    #----------------------------------------------
    # Paste the value into the destination file
    #----------------------------------------------

    $destinationWorkSheet.Paste($destinationWorkSheet.Range($rangeToCopyStart, $rangeToCopyEnd)); 
    $destinationWorkbook.Close($True);  #save changes and close

    "Copied to: " + $destinationFile;
}


#----------------------------------------------
# Quit Excel and release the object
#----------------------------------------------

$excelApplication.Quit();
[System.Runtime.Interopservices.Marshal]::ReleaseComObject($excelApplication) | out-null;

答案 1 :(得分:0)

'嗨,在您的要求代码下面...请注意您可以根据您的要求更改myextension ..

Sub Button2_Click()

'目的:遍历用户选择的文件夹中的所有工作簿并执行类似的任务

    Dim wb As Workbook
    Dim myPath As String
    Dim myFile As String
    Dim myExtension As String
    Dim FldrPicker As FileDialog

    'Optimize Macro Speed
      Application.ScreenUpdating = False
      Application.EnableEvents = False
      Application.Calculation = xlCalculationManual
      Application.DisplayAlerts = False

    'Retrieve Target Folder Path From User
      Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker)

        With FldrPicker
          .Title = "Select A Target Folder"
          .AllowMultiSelect = False
            If .Show <> -1 Then GoTo NextCode
            myPath = .SelectedItems(1) & "\"
        End With

    'In Case of Cancel

NextCode:           myPath = myPath           如果myPath =&#34;&#34;然后GoTo重置设置

    'Target File Extension (must include wildcard "*")
      myExtension = "*.xlsx"

    'Target Path with Ending Extention
      myFile = Dir(myPath & myExtension)

    'Loop through each Excel file in folder
      Do While myFile <> ""
        'Set variable equal to opened workbook
          Set wb = Workbooks.Open(Filename:=myPath & myFile)

        'Change First Worksheet's Background Fill Blue
          wb.Worksheets(1).Range("A1:Z1").Interior.Color = RGB(51, 98, 174)

        'Save and Close Workbook
          wb.Close SaveChanges:=True

        'Get next file name
          myFile = Dir
      Loop

    'Message Box when tasks are completed
      MsgBox "Task Complete!"

ResetSettings:           &#39;重置宏优化设置             Application.EnableEvents = True             Application.Calculation = xlCalculationAutomatic             Application.ScreenUpdating = True             Application.DisplayAlerts = True

End Sub

答案 2 :(得分:-2)

是的,您可以在源工作簿中编写vba模块,循环遍历目标文件夹中的文件,打开它(使用Workbooks.Open方法),添加所需的单元格并保存。