-
vba复制整个sheet内容_VBA将数据从一个工作表复制到另一个工作表
2021-02-04 23:22:56我需要编写一个宏来读取列C中的工作表名称,并将源工作簿中的值粘贴到目标工作簿中的范围,该范围在列D中指定 .因此,例如,它需要复制Myworkbook book的Sheet2中的数据,并将其粘贴到他们的工作簿Sheet2的范围内 ....我对VBA很新,需要一些项目帮助 . 我需要编写一个宏来读取列C中的工作表名称,并将源工作簿中的值粘贴到目标工作簿中的范围,该范围在列D中指定 .
因此,例如,它需要复制Myworkbook book的Sheet2中的数据,并将其粘贴到他们的工作簿Sheet2的范围内 . 范围和工作表编号信息存储在单独工作簿中的位置 .
编辑:我添加了一张wbOpen的图片 . This is it here.
Option Explicit
Sub PasteToTargetRange()
Dim arrVar As Variant 'stores all the sheets to get the copied
Dim arrVarTarget As Variant 'stores names of sheets in target workbook
Dim rngRange As Range 'each sheet name in the given range
Dim rngLoop As Range 'Range that rngRange is based in
Dim wsSource As Worksheet 'source worksheet where ranges are found
Dim wbSource As Workbook 'workbook with the information to paste
Dim wbTarget As Workbook 'workbook that will receive information
Dim strSourceFile As String 'location of source workbook
Dim strTargetFile As String 'location of source workbook
Dim wbOpen As Workbook 'Current open workbook(one with inputs)
Dim wsRange As Range 'get information from source workbook
Dim varRange As Range 'Range where values should be pasted
Dim i As Integer 'counter for For Loop
Dim wbkNewSheet As Worksheet 'create new worksheet if target workbook doesn't have
Dim wsTarget As Worksheet 'target workbook worksheet
Dim varNumber As String 'range to post
Set wbOpen = Workbooks.Open("WorkbookWithRanges.xlsx")
'Open source file
MsgBox ("Open the source file")
strSourceFile = Application.GetOpenFilename
If strSourceFile = "" Then Exit Sub
Set wbSource = Workbooks.Open(strSourceFile)
'Open target file
MsgBox ("Open the target file")
strTargetFile = Application.GetOpenFilename
If strTargetFile = "" Then Exit Sub
Set wbTarget = Workbooks.Open(strTargetFile)
'Activate transfer Workbook
wbOpen.Activate
Set wsRange = ActiveSheet.Range("C9:C20")
Set arrVarTarget = wbTarget.Worksheets
For Each varRange In wsRange
If varRange.Value = 'Target workbook worksheets
varNumber = varRange.Offset(0, -1).Value
Set wsTarget = X.Offset(0, 1)
wsSouce.Range(wsTarget).Value = varNumber
Else
wbkNewSheet = Worksheets.Add
wbkNewSheet.Name = varRange.Value
End If
Next
End Sub
-
VBA:自动化跨工作簿复制粘贴及排序
2021-02-07 10:57:14从一个工作簿各个子表中复制数据粘贴到另一个工作簿指定位置中,并对指定列进行排序,这个是我们在日常工作中经常做的,如何减少繁琐的工作步骤,提高效率,一键完成上面的工作。下面介绍通过VBA,如何自动化跨工作...从一个工作簿各个子表中复制数据粘贴到另一个工作簿指定位置中,并对指定列进行排序,这个是我们在日常工作中经常做的,如何减少繁琐的工作步骤,提高效率,一键完成上面的工作。下面介绍通过VBA,如何自动化跨工作簿复制粘贴及排序。
图一
图二
需要将图一工作簿中三个子表含有公式的数据,复制粘贴数值到图二的表1,并对指定列进行降序排序,可以直接点击图二中执行的控件即可完成;以下是VBA脚本的实现。Sub scopy2() ' ' 复制粘贴及排序 ' '复制粘贴 Application.ScreenUpdating = False '禁止屏幕更新数据 Windows("xxx.xlsx").Activate '图一的表名 Sheets("表一").Select Range("B5:X19").Select Selection.Copy '复制 Windows("aaaa.xlsm").Activate '图二的表名 Sheets("1").Select Range("A6").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '粘贴成数值 Windows("xxx.xlsx").Activate '图一的表名 Sheets("表二").Select ' Range("B5:T19").Select Application.CutCopyMode = False Selection.Copy Windows("aaaa.xlsm").Activate '图二的表名 Sheets("1").Select Range("Y6").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False Windows("xxx.xlsx").Activate Sheets("表三").Select Range("B6:R20").Select Application.CutCopyMode = False Selection.Copy Windows("aaaa.xlsm").Activate Sheets("1").Select Range("AS6").Select Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ :=False, Transpose:=False '筛选排序 Windows("aaaa.xlsm").Activate Sheets("1").Select Range("A6:w20").Select Selection.AutoFilter '筛选 ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields.Clear ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields.Add2 Key:=Range( _ "b6:b20"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _ xlSortNormal '筛选并对指定列进行排序 With ActiveWorkbook.Worksheets("1").AutoFilter.Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("I10").Select Selection.AutoFilter Range("y6:Aq20").Select Selection.AutoFilter ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields.Clear ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields.Add2 Key:=Range( _ "Ab6:Ab20"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("1").AutoFilter.Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("AB9").Select Selection.AutoFilter Range("As6:Bi20").Select Selection.AutoFilter ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields.Clear ActiveWorkbook.Worksheets("1").AutoFilter.Sort.SortFields.Add2 Key:=Range( _ "At6:At20"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _ xlSortNormal With ActiveWorkbook.Worksheets("1").AutoFilter.Sort .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With Range("AS12").Select Selection.AutoFilter '去掉筛选 Application.ScreenUpdating = True '解除禁止屏幕更新数据 End Sub
在图二的子表1的表名点右键,点击查看代码,插入模块1,粘贴上面的代码,保存。
回到表格,在开发工具里-插入-表单控件
选中控件点右键可以选择指定的宏名称,同时修改控件名称。
-
excel中161个VBA_自定义函数超级实用
2018-03-28 08:36:32函数作用:在多个工作表中查找一个范围内符合某个指定条件的项目对应指定范围加总求和..........................59 '35.函数作用:返回 Column 英文字.......................60 '36.函数作用:查找指定列名的列数....... -
VBA常用技巧
2014-12-21 16:39:28技巧8 仅复制数值到另一区域 12 8-1 使用选择性粘贴 12 8-2 直接赋值的方法 12 技巧9 单元格自动进入编辑状态 12 技巧10 禁用单元格拖放功能 12 技巧11 单元格格式操作 12 11-1 单元格字体格式设置 12 11-2 设置... -
VBA编程技巧大全
2013-08-05 09:03:19技巧8 仅复制数值到另一区域 30 8-1 使用选择性粘贴 30 8-2 直接赋值的方法 31 技巧9 单元格自动进入编辑状态 32 技巧10 禁用单元格拖放功能 32 技巧11 单元格格式操作 33 11-1 单元格字体格式设置 33 11-2 设置... -
VBA程序集(第2辑)
2011-07-17 22:11:00VBA程序集 (第2辑) ...一旦找到匹配的数据,就将其复制到另一个工作表(“搜索结果”)中。 [条件]要求有一个命名为“搜索结果”的工作表。 [程序扩展](1)可以修改程序指定需搜索的值...VBA程序集
(第2辑)*********************************************
程序6(查找)
[程序功能] 搜索值并输入到单独的工作表中。在当前工作表的列中搜索单词(“您好”)。一旦找到匹配的数据,就将其复制到另一个工作表(“搜索结果”)中。
[条件]要求有一个命名为“搜索结果”的工作表。
[程序扩展](1)可以修改程序指定需搜索的值,也可以在该处设计一个输入框用来选取或输入要搜索的值。
(2)可以修改指定当前工作表搜索的范围。
(3)程序在搜索到指定的数据后,将会把包含此数据的整行复制到指定的工作表。可以进行修改,只复制指定的数据。同时,也可以将程序应用到设定搜索条件,搜索到满足条件的数据后,将得到整条记录结果(即查找满足条件的记录)。
[程序代码]
Option Explicit
Sub FindMe()
Dim intS As Integer
Dim rngC As Range
Dim strToFind As String, FirstAddress As String
Dim wSht As WorksheetApplication.ScreenUpdating = False
intS = 1
Set wSht = Worksheets("搜索结果")
strToFind = "您好" '指定搜索的值With ActiveSheet.Range("A1:C20") '可根据实际工作表改变范围.
Set rngC = .Find(what:=strToFind, LookAt:=xlPart)
If Not rngC Is Nothing Then
FirstAddress = rngC.Address
Do
rngC.EntireRow.Copy wSht.Cells(intS, 1)
intS = intS + 1
Set rngC = .FindNext(rngC)
Loop While Not rngC Is Nothing And rngC.Address <> FirstAddress
End If
End WithApplication.ScreenUpdating = True
End Sub
示例文档见UploadFiles/2006-6/617259916.rar
***************************************
程序7(查找)
[程序功能] 根据值插入行。在某一列中搜索某个值,当找到该值时,就插入一个空行。
[条件] 下面的程序假设在 B 列中搜索值“1”,当找到该值时,就插入一个空行。
[程序扩展] 可以改变要搜索的值,或用对话框交互。也可改变搜索的范围。
[程序代码]
Sub 根据搜索值插入行()
Dim Rng As Range
Dim findstring As String
findstring = "1" '要搜索的值,在具体应用时可根据需要改变Set Rng = Range("B:B").Find(What:=findstring, LookAt:=xlWhole) '根据实际改变范围
While Not (Rng Is Nothing)
Rng.EntireRow.Insert
Set Rng = Range("B" & Rng.Row + 1 & ":B" & Rows.Count).Find(What:=findstring, LookAt:=xlWhole)
Wend
End Sub示例文档见UploadFiles/2006-6/617931442.rar
**************************************
程序8
[程序说明] 在活动工作表上的某列单元格中的数据是其它工作表名,运行程序后,工作表名单元格所在的行将被复制到与单元格内容同名的工作表中。运行程序时,源数据表必须为活动工作表。
[程序扩展] 本示例提供了一个思路,即可以将源数据工作表的数据根据特定的值进行筛选,并将筛选后的结果展示在新的不同的工作表中。
示例中值在第11列,即K列,可以根据情况改为第1列或其它列。
可根据情况进一步拓展。
[程序代码]
Sub ProcessRows()
Dim lngRowSource As Long
Dim lngRowTarget As Long
Dim strStatus As String
For lngRowSource = 1 To 25
'工作表的名字在第11列,也可以随需要更改如改为第1列
strStatus = ActiveSheet.Cells(lngRowSource, 11).Value
If strStatus <> "" Then
lngRowTarget = TargetRow(Sheets(strStatus))
ActiveSheet.Range(Cells(lngRowSource, 1), Cells(lngRowSource, 15)).Copy _
Sheets(strStatus).Cells(lngRowTarget, 1)
End If
Next
End Sub
Function TargetRow(ws As Worksheet) As Long '返回第一个空行的行号
Dim lngLastRow As Long
'在第11列即K列中查找空单元格,也可以根据情况改为第1列
lngLastRow = ws.Cells(Rows.Count, 11).End(xlUp).Row
If IsEmpty(ws.Cells(lngLastRow, 11)) Then
TargetRow = 1
Else
TargetRow = lngLastRow + 1
End If
End Function示例文档见UploadFiles/2006-6/617710918.rar
***************************************
程序9(窗体控件——列表框/组合框)
[程序功能] 对逐层分类以及与逐层分类相似结构的表格,通过列表框/组合框来实现:第一个列表框/组合框为第一层分类,第二个列表框/组合框为第一层分类选择的类别所属的分类……依此类推。
[程序扩展] (1)本示例用列表框实现,也可用组合框实现。
(2)当数据工作表不是当前表时,可对程序进行适当修改,即列表框/组合框数据引自其它的工作表。因此,可以将数据工作表作为隐藏的数据源。
[程序代码]
Option Explicit
Private Sub UserForm_Initialize()
AddFruit Range([A1], [A1].End(xlDown))
ListBox1.ListIndex = 0
With Label1
.Caption = Cells(1, 1).Value
.Font = "隶书"
End With
With Label2
.Caption = Cells(1, 2).Value
.Font = "隶书"
End With
With Label3
.Caption = Cells(1, 3).Value
.Font = "隶书"
End With
End Sub
Sub AddFruit(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
On Error Resume Next
d.Add cel.Text, cel.Text
Next
ListBox1.List() = d.items
End Sub
'********************************
Private Sub ListBox1_Change()
ListBox2.Clear
AddType Range([B1], [B1].End(xlDown))
ListBox2.ListIndex = 0
ListBox3.ListIndex = -1
End Sub
Sub AddType(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
If cel.Offset(, -1) = ListBox1 Then
On Error Resume Next
d.Add cel.Text, cel.Text
End If
Next
ListBox2.List() = d.items
End Sub
'********************************
Private Sub ListBox2_Change()
ListBox3.Clear
AddMake Range([C1], [C1].End(xlDown))
If ListBox2 <> "" Then ListBox3.ListIndex = 0
End Sub
Sub AddMake(Data As Range)
Dim d, cel As Range
Set d = CreateObject("Scripting.Dictionary")
For Each cel In Data
If cel.Offset(, -1) = ListBox2 Then
On Error Resume Next
d.Add cel.Text, cel.Text
End If
Next
ListBox3.List() = d.items
End Sub示例文档见UploadFiles/2006-6/617411253.rar
***************************************
程序10(窗体控件——列表框/组合框)
[程序说明] 要求能实现连续打印。Sheet2为源数据,Sheet1为结果,在Sheet1表中,网友已用数据有效性功能根据电脑编号实现不同人员的表单显示,即在下拉列表中选择电脑编号,显示相应人员的表单。如果需要将这些表单全打印出来,数据量大的话,需要在下拉列表中一个个选,然后击工具栏上的“打印”按钮,重复操作,很费时,且容易操作错误(重选、漏选)。
[程序思路] 只能使用VBA实现,考虑用户窗体中的控件。可选用组合框或列表框,这里用的是列表框。将数据源(即电脑编号)添加到列表框,然后赋值给Sheet1中“电脑编号”区域(已命名为“computer”,即设置数据有效性的区域),在列表框项目中循环,并实现连续打印。
[界面]一个列表框,设置为隐藏;一个按钮,用于激活列表框以实现连续打印控制。
[程序代码]
Private Sub CommandButton1_Click()
ListBox1.ListIndex = 0
End Sub
'注:ListBox1.ListIndex = 0语句不能在listBox1_Change()过程中,应在其它过程中,以激发列表框变化,从而'激活listBox_Change事件,调用事件过程中的循环语句,改变工作表中的数据,相应得到各编号表单,并打印Private Sub listBox1_Change()
'可以用VBA语句将工作表中的值赋给列表框,本例中在属性的RowSource进行赋值
'将列表框中的数据与设值了有效性的单元格建立链接Range("computer").Value = ListBox1.Value
For j = 0 To ListBox1.ListCount - 1 '从列表框中的第一项循环至最后一项
Range("computer").Value = ListBox1.List(j) '将列表框每项数据赋值给单元格区域,工作表中产生相应表单
Sheets(1).PrintOut Copies:=1, Collate:=True '打印
Next j
Unload UserForm1 '关闭窗体
End Sub'在ThisWorkbook中设置工作簿打开时的动作
Private Sub Workbook_Open()
UserForm1.Show
End Sub注:load方法可以装载窗体,但窗体是隐藏的。
-
Excel2010VBA批量插入或导出图片
2016-09-16 15:07:232.再另外打开你自己需要操作的另一个Excel文件,并保持你要操作的工作表做为当前活动工作表; 3.在你的文件中按Ctrl+I (或在你的文件中手动执行宏,然后选择本EXCEL文件中的宏InsertPic3); 4.然后会出现文件夹选择... -
EXCEL VBA常用技巧
2010-02-09 22:28:27技巧8 仅复制数值到另一区域 23 8-1 使用选择性粘贴 23 8-2 直接赋值的方法 24 技巧9 单元格自动进入编辑状态 25 技巧10 禁用单元格拖放功能 25 技巧11 单元格格式操作 26 11-1 单元格字体格式设置 26 11-2 设置... -
我整理的VBA 自定义函数大全 共138页
2008-11-21 16:14:0334.在多个工作表中查找一个范围内符合某个指定条件的项目对应指定范围加总求和 35.返回 Column 英文字 36.查找指定列名的列数 37.文字格式的时间(分:秒)转化为数字格式(秒) 38.将"hh:mm:ss"格式的时分秒数转换成秒数... -
网管教程 从入门到精通软件篇.txt
2010-04-25 22:43:49下列命令示例向指定设备写入一个新的主引导记录: fixmbr DeviceHardDisk0 注意 如果不指定 device_name,新的主引导记录将被写入引导设备,即装载主系统的驱动器。 如果系统检测到无效或非标准分区表标记... -
Excel百宝箱
2012-10-27 17:09:21【返回首页】:配合建立工作表目录工具使用,可以在任何工作表中瞬间返回第一个工作表 【工作簿标签】:将当前开启的工作簿创建一个方便切换标签,置于工作表上方。可通过Ctrl+Shift+T切换显示状态,可以通过右键菜单... -
Excel百宝箱9.0无限制破解版
2012-02-03 19:05:29【返回首页】:配合建立工作表目录工具使用,可以在任何工作表中瞬间返回第一个工作表 【工作簿标签】:将当前开启的工作簿创建一个方便切换标签,置于工作表上方。可通过Ctrl+Shift+T切换显示状态,可以通过右键菜单... -
Excel百宝箱9.0无限制破解版.rar
2012-09-05 09:31:51【返回首页】:配合建立工作表目录工具使用,可以在任何工作表中瞬间返回第一个工作表 【工作簿标签】:将当前开启的工作簿创建一个方便切换标签,置于工作表上方。可通过Ctrl+Shift+T切换显示状态,可以通过右键... -
Exce百宝箱——2012版本.rar
2012-10-19 19:52:33【返回首页】:配合建立工作表目录工具使用,可以在任何工作表中瞬间返回第一个工作表 【工作簿标签】:将当前开启的工作簿创建一个方便切换标签,置于工作表上方。可通过Ctrl+Shift+T切换显示状态,可以通过右键菜单... -
excel的使用
2012-11-25 17:06:01图2(8) 利用Ctrl+*选取文本如果一个工作表中有很多数据表格时,可以通过选定表格中某个单元格,然后按下Ctrl+*键可选定整个表格。Ctrl+*选定的区域为:根据选定单元格向四周辐射所涉及到的有数据单元格的最大... -
Excel2007图表完全剖析 8/8
2012-04-01 10:28:281.4.5 将图表移到另一个工作表中 14 1.5 使用“设计”选项卡自定义图表 15 1.5.1 选择图表布局 16 1.5.2 选择颜色方案 16 1.5.3 通过改变主题来修改颜色方案 17 1.6 创建自己的主题 18 1.6.1 从已有的... -
Excel2007图表完全剖析 5/8
2012-04-01 10:11:021.4.5 将图表移到另一个工作表中 14 1.5 使用“设计”选项卡自定义图表 15 1.5.1 选择图表布局 16 1.5.2 选择颜色方案 16 1.5.3 通过改变主题来修改颜色方案 17 1.6 创建自己的主题 18 1.6.1 从已有的... -
Excel2007图表完全剖析 7/8
2012-04-01 10:23:551.4.5 将图表移到另一个工作表中 14 1.5 使用“设计”选项卡自定义图表 15 1.5.1 选择图表布局 16 1.5.2 选择颜色方案 16 1.5.3 通过改变主题来修改颜色方案 17 1.6 创建自己的主题 18 1.6.1 从已有的... -
Excel2007图表完全剖析 6/8
2012-04-01 10:16:461.4.5 将图表移到另一个工作表中 14 1.5 使用“设计”选项卡自定义图表 15 1.5.1 选择图表布局 16 1.5.2 选择颜色方案 16 1.5.3 通过改变主题来修改颜色方案 17 1.6 创建自己的主题 18 1.6.1 从已有的... -
Excel2007图表完全剖析 4/8
2012-04-01 10:03:091.4.5 将图表移到另一个工作表中 14 1.5 使用“设计”选项卡自定义图表 15 1.5.1 选择图表布局 16 1.5.2 选择颜色方案 16 1.5.3 通过改变主题来修改颜色方案 17 1.6 创建自己的主题 18 1.6.1 从已有的... -
Excel2007图表完全剖析 3/8
2012-04-01 09:55:171.4.5 将图表移到另一个工作表中 14 1.5 使用“设计”选项卡自定义图表 15 1.5.1 选择图表布局 16 1.5.2 选择颜色方案 16 1.5.3 通过改变主题来修改颜色方案 17 1.6 创建自己的主题 18 1.6.1 从已有的... -
Excel2007图表完全剖析 2/8
2012-04-01 09:47:251.4.5 将图表移到另一个工作表中 14 1.5 使用“设计”选项卡自定义图表 15 1.5.1 选择图表布局 16 1.5.2 选择颜色方案 16 1.5.3 通过改变主题来修改颜色方案 17 1.6 创建自己的主题 18 1.6.1 从已有的... -
Excel2007图表完全剖析 1/8
2012-04-01 09:42:201.4.5 将图表移到另一个工作表中 14 1.5 使用“设计”选项卡自定义图表 15 1.5.1 选择图表布局 16 1.5.2 选择颜色方案 16 1.5.3 通过改变主题来修改颜色方案 17 1.6 创建自己的主题 18 1.6.1 从已有的... -
中文版SQL Server2000开发与管理应用实例>>随书源码
2009-02-19 22:23:46│ 得到一个字符串在另一个字符串中出现的次数.sql │ 数字转换成十六进制.sql │ 比较第一与第二个字符串,是否有连续的5个字符相同.sql │ 生成查询的模糊匹配字符串.sql │ 简繁转换.sql │ 统计一个表中某个字符... -
Access 2000数据库系统设计(PDF)---001
2006-02-23 15:31:041637.5.3 使用分隔文本文件 1657.5.4 处理宽度固定的文本文件 1667.5.5 追加文本数据到一个现有的表 1677.6 使用剪贴板导入数据 1677.6.1 向一个表粘贴新记录 1687.6.2 通过从剪贴板上粘贴来替换记录 1707.7 从... -
Access+2000中文版高级编程
2012-02-05 09:20:256.3.2 与另一个数据库连接 119 6.4 使用ADO创建记录集 120 6.4.1 打开简单的记录集 120 6.4.2 循环搜索和编辑记录集 122 6.4.3 创建永久记录集 124 6.4.4 使用RecordCount, BOF和EOF属性 125 6.4.5 检查... -
Access 2000数据库系统设计(PDF)---031
2006-02-23 15:31:0430413.3.5 创建绑定、多行、计算文本框 30513.3.6 改变属性的默认视图和获取帮助 30813.3.7 用向导添加选项组 30813.3.8 使用剪贴板复制控件到其他窗体 31113.3.9 使用组合和列表框 31213.3.10 创建一个组合框来查找...