我在同一个文件夹中有大约300个工作簿,我想将单个B19-B49从1个工作簿复制到同一文件夹中的300个工作簿的其余部分。这有可能以一些聪明的方式,所以我不必复制粘贴300个不同的文件?
祝你好运
答案 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方法),添加所需的单元格并保存。