如何让宏填充到现有文件 [英] How to get macro to populate to an existing file
问题描述
这可能是一个简单的修正，但我对编写宏非常陌生。 下面我在互联网上创建了一个使用多个来源的宏。 我有一切按照我需要的方式工作，除了一个小问题。 现在它将
所有我需要的数据填充到一个全新的Excel工作簿中。 我需要它来填充现有文件。 我尝试只输入当前正在添加新工作簿的文件位置，但它返回时出现错误。 下面是我的宏观文字
，我已经在 Bold 中添加了我需要帮助的部分。 如果你需要，这里是我需要填充数据的实际文件位置...."C：\Documents and Settings \azale\Desktop\Andrew'\Rep Database"。 感谢
提前帮助。
Sub MergeAllWorkbooks（）
; Dim MyPath As String，FilesInPath As String
Dim MyFiles（）As String
Dim SourceRcount As Long，FNum As Long
Dim mybook As Workbook，BaseWks As Worksheet
Dim sourceRange As Range，destrange As Range
Dim rnum As Long，CalcMode As Long
'将此更改为文件的路径\文件夹位置。
MyPath =" C：\Documents and Settings \azale\Desktop\Andrew'\Clients"
'如果需要，在路径末尾添加斜杠。
如果正确（MyPath，1）<> " \"然后
MyPath = MyPath& " \"
结束如果
'如果文件夹中没有Excel文件，请退出。
FilesInPath = Dir（MyPath&" * .xl *"）
如果FilesInPath =""然后
MsgBox"未找到任何文件"< b $ b 退出子
结束如果
'使用Excel文件列表填写myFiles数组
'在搜索文件夹中。
FNum = 0
Do While FilesInPath<> ""
FNum = FNum + 1
ReDim保留MyFiles（1至FNum）
MyFiles（FNum）= FilesInPath
FilesInPath = Dir（）
循环
'设置各种应用程序属性。
应用程序
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
结束
'添加一张新工作簿。
设置BaseWks = Workbooks.Add（xlWBATWorksheet）.Worksheets（1）
rnum = 3
'循环遍历myFiles数组中的所有文件。
如果FNum> 0然后
对于FNum = LBound（MyFiles）至UBound（MyFiles）
设置mybook = Nothing
On Error Resume Next
设置mybook = Workbooks.Open（MyPath& MyFiles（FNum））
On Error GoTo 0
如果Not mybook Is Nothing则为
On Error Resume Next
'更改此范围以满足您自己的需要。
与mybook.Worksheets（QUOT;客户总结"）
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP;&NBSP;&NBSP;设置sourceRange = .Range（QUOT; A2：M2"）
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;结束
如果Err.Number> 0然后
Err.Clear
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;设置sourceRange = Nothing
否则，
'如果来源范围使用所有列，则为&b $ b &NBSP;&NBSP; "跳过这个文件
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;如果sourceRange.Columns.Count> = BaseWks.Columns.Count然后
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;设置sourceRange =无
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;结束如果
结束如果
错误转到0
如果不sourceRange是Nothing然后
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP;&NBSP; SourceRcount = sourceRange.Rows.Count
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP;&NBSP;&NBSP;如果RNUM + SourceRcount> = BaseWks.Rows.Count然后
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; MSGBOX"有没有在目标工作表足够的行"&NBSP;
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; BaseWks.Columns.AutoFit
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP;&NBSP;&NBSP;&NBSP; mybook.Close的SaveChanges：=假
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;转到ExitTheSub
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;其他
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP;&NBSP;&NBSP;&NBSP; '复制A栏中的文件名。
;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;随着sourceRange
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; BaseWks.Cells（rnum，"A"）。 _
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;调整大小（.Rows.Count）。价值= MYFILES（FNUM）
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;一端与
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP;&NBSP;&NBSP;&NBSP; "设置目标范围
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP;&NBSP;&NBSP;&NBSP;&NBSP;设置destrange = BaseWks.Range（QUOT; B"&安培; RNUM）
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; '复制来自源范围的值
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; '到目的地范围。
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;随着sourceRange
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;设置destrange = destrange。 _
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;
调整尺寸（.Rows.Count，.Columns.Count）
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;一端与
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; &NBSP;&NBSP;&NBSP; destrange.Value = sourceRange.Value
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP; RNUM = RNUM + SourceRcount
&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP;&NBSP ;结束如果
结束如果
mybook.Close savechanges：= False
结束如果
下一页FNum
BaseWks.Columns.AutoFit
结束如果
ExitTheSub：
'恢复应用程序属性。
应用程序
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
以$
End Sub结束
不知道你的文件扩展名是什么（我猜的.xlsx），但改变
'
添加一张新工作簿。
Set BaseWks = Workbooks.Add（xlWBATWorksheet）.Worksheets（1）
rnum = 3
to
Set BaseWks = Workbooks.Open（ " C：\Documents
和Settings\azale\Desktop\Andrew'\Rep数据库。 XLSX"） <强烈风格="边界：0像素;字型家族： '濑越UI'， '很好的可读性'，宋体，Arial字体，黑体，无衬线;余量：0像素;轮廓：0像素;填充： 0px;颜色：＃333333;行高：17px">。工作表（1）
确保路径是corr等等 - 单引号是不太可能的字符......
你可能想要改变
rnum = 3
to
With BaseWks
rnum = .Cells（.Rows.Count，" A"）。End（xlUp）.Row
End With
$
This is probably a simple correction but I am pretty new to writing macros. Below I have created a macro using multiple sources on the internet. I have everything working the way I need it to except for one small problem. Right now it populates all of my needed data into a brand new excel workbook. I need it to populate to an existing file. I tried just typing in the file location where it is currently adding a new workbook, but it comes back with an error. Below is my macro text and I have put the section I need help with in Bold. If you need it here is the actual file location that I need the data populated to.... "C:\Documents and Settings\azale\Desktop\Andrew'\Rep Database". Thanks for your help in advance.
Sub MergeAllWorkbooks()
Dim MyPath As String, FilesInPath As String
Dim MyFiles() As String
Dim SourceRcount As Long, FNum As Long
Dim mybook As Workbook, BaseWks As Worksheet
Dim sourceRange As Range, destrange As Range
Dim rnum As Long, CalcMode As Long
' Change this to the path\folder location of your files.
MyPath = "C:\Documents and Settings\azale\Desktop\Andrew'\Clients"
' Add a slash at the end of the path if needed.
If Right(MyPath, 1) <> "\" Then
MyPath = MyPath & "\"
End If
' If there are no Excel files in the folder, exit.
FilesInPath = Dir(MyPath & "*.xl*")
If FilesInPath = "" Then
MsgBox "No files found"
Exit Sub
End If
' Fill the myFiles array with the list of Excel files
' in the search folder.
FNum = 0
Do While FilesInPath <> ""
FNum = FNum + 1
ReDim Preserve MyFiles(1 To FNum)
MyFiles(FNum) = FilesInPath
FilesInPath = Dir()
Loop
' Set various application properties.
With Application
CalcMode = .Calculation
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
' Add a new workbook with one sheet.
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
rnum = 3
' Loop through all files in the myFiles array.
If FNum > 0 Then
For FNum = LBound(MyFiles) To UBound(MyFiles)
Set mybook = Nothing
On Error Resume Next
Set mybook = Workbooks.Open(MyPath & MyFiles(FNum))
On Error GoTo 0
If Not mybook Is Nothing Then
On Error Resume Next
' Change this range to fit your own needs.
With mybook.Worksheets("Client Summary")
Set sourceRange = .Range("A2:M2")
End With
If Err.Number > 0 Then
Err.Clear
Set sourceRange = Nothing
Else
' If source range uses all columns then
' skip this file.
If sourceRange.Columns.Count >= BaseWks.Columns.Count Then
Set sourceRange = Nothing
End If
End If
On Error GoTo 0
If Not sourceRange Is Nothing Then
SourceRcount = sourceRange.Rows.Count
If rnum + SourceRcount >= BaseWks.Rows.Count Then
MsgBox "There are not enough rows in the target worksheet."
BaseWks.Columns.AutoFit
mybook.Close savechanges:=False
GoTo ExitTheSub
Else
' Copy the file name in column A.
With sourceRange
BaseWks.Cells(rnum, "A"). _
Resize(.Rows.Count).Value = MyFiles(FNum)
End With
' Set the destination range.
Set destrange = BaseWks.Range("B" & rnum)
' Copy the values from the source range
' to the destination range.
With sourceRange
Set destrange = destrange. _
Resize(.Rows.Count, .Columns.Count)
End With
destrange.Value = sourceRange.Value
rnum = rnum + SourceRcount
End If
End If
mybook.Close savechanges:=False
End If
Next FNum
BaseWks.Columns.AutoFit
End If
ExitTheSub:
' Restore the application properties.
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = CalcMode
End With
End Sub
Not sure what your file extension is (I guessed .xlsx) but change
' Add a new workbook with one sheet.
Set BaseWks = Workbooks.Add(xlWBATWorksheet).Worksheets(1)
rnum = 3to
Set BaseWks = Workbooks.Open("C:\Documents and Settings\azale\Desktop\Andrew'\Rep Database.xlsx").Worksheets(1)
Make sure that the path is correct - the single quote is an unlikely character....
and you may want to change
rnum = 3
to
With BaseWks
rnum = .Cells(.Rows.Count,"A").End(xlUp).Row
End With
这篇关于如何让宏填充到现有文件的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
