将单元格从一个工作簿复制到多个工作簿excel

Question

I have around 300 workbooks in the same folder, and i want to copy cell B19-B49 from 1 workbook into the rest of the 300 workbooks in the same folder. Is that possible in some clever way so I dont have to copy-paste through 300 different files?

Best regards

Answer 1

Use a simple PowerShell script to copy the value from the source file to the files in the destination directory. Just replace the 5 variables at the top with your values:

$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;

Answer 2

'Hi Below the code for your requirement...please note you can change the myextension as per your requirement..

Sub Button2_Click()

'PURPOSE: To loop through all workbooks in a user selected folder and perform a similar task

    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 If myPath = "" Then GoTo ResetSettings

    '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: 'Reset Macro Optimization Settings Application.EnableEvents = True Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True Application.DisplayAlerts = True

End Sub

Answer 3

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