最佳解答
以下程式預定從 C2 複製到 C6
Option Explicit Const kRowCount = 300 Sub Main() Dim nI For nI = 2 To 6 OneCopy (nI) Next nI End Sub Sub OneCopy(ByVal pIdx As Integer) Dim nRowBegin, nRowEnd nRowBegin = 2 + (pIdx - 2) * kRowCount nRowEnd = nRowBegin + kRowCount - 1 Sheets("SheetB").Select Range("C" & pIdx).Select Selection.Copy Sheets("SheetA").Select Range("B" & nRowBegin).Select ActiveSheet.Paste Range("B" & nRowBegin & ":B" & nRowEnd).Select Selection.FillDown End Sub另外,點這裡是我這次鐵人賽唯一的一篇文章,喜歡的話左上角點 Like
回應 1
- 檢舉
2022-12-08 01:16:35分类:首页 > 办公
一、如何用VBA新建一个EXCEL表,并将将另一个EXCEL表中的内容复制
Sub 新建()
Dim excelApp, excelWB As Object
Dim savePath As String
Set excelApp = CreateObject("Excel.Application")
Set excelWB = excelApp.Workbooks.Add
excelApp.DisplayAlerts = False
savePath = ActiveWorkbook.Path & "\新建表1.xls"
excelWB.SaveAs savePath
excelApp.Quit
Workbooks.Open savePath
End Sub
内容复制:
Workbooks("计算表.xls").Worksheets("Sheet1").Copy Before:=Workbooks("新建表1.xls").Sheets(1)
把“计算表”的Sheet1整个复制到“新建表1”中,为最前面一个Sheet,默认命名将是“Sheet1(2)”,楼主可以再重新命名Sheet就行了。
二、excel vba复制内容及格式
将复制这行拆分,复制后选择性粘贴:
Rows(x & ":" & n).EntireRow.Copy
Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
如果是复制的单元格格式,再加上下面一句
Range("A1").PasteSpecial xlPasteFormats
另外,Rows本身就是整行引用,EntireRow在这里就是重复的,可取消,直接改为:
Rows(x & ":" & n).Copy
三、VBA将EXCEL筛选后内容复制到新工作表
【1】xlS.[a1] 改为 xlS.Range("A1")【2】Activesheet,这时是你 新建的 Sheet,不是你有数据的Sheet,可以先激活你有数据的Sheet,如:Workbooks("你有数据的工作表名").Worksheets(1).Active 然后再Copy或者在新建一个Workbook之前,如果 有数据的Workbooks中的SHeet是当前激活的 SHeet,则可以先将它赋值给变量。
dim AS =New Worksheet set AS=Activesheet然后再建立新的工作表,Copy时用:AS.Range("A2:F20").SpecialCells(xlCellTypeVisible).Copy xlS.Range("A1")。
四、VBA 用excel模块复制word的表格内容
试试下面的代码:Sub 宏1() Dim wordapp As Object Dim mydoc Dim mypath$, myname$ Dim wdRng As Object Dim pos1%, pos2% '定义找到的字段的首位位置 Application.DisplayAlerts = False Set wordapp = CreateObject("word.application") mypath = ThisWorkbook.Path & "" myname = Dir(mypath & "*.doc*") Set mydoc = wordapp.Documents.Open(mypath & myname) Set wdRng = mydoc.Range wdRng.Find.Execute ("(一)") pos1 = wdRng.Start Set wdRng = mydoc.Range wdRng.Find.Execute ("五、") pos2 = wdRng.Start mydoc.Range(pos1, pos2).Copy '选中找到的两个字段中间的内容 mydoc.Close False wordapp.Quit Worksheets("Sheet2").Select Range("A1").Select ActiveSheet.Paste Application.ScreenUpdating = True Application.DisplayAlerts = TrueEnd Sub。
五、EXCEL VBA复制行内容到另表
Sub s()
Dim rg1 As Range, rg2 As Range, c As Range
Set rg1 = Sheets("问1").[L5:XFD6]
Set rg2 = Sheets("问1结果").[D31:M69]
For Each c In rg1
If c "" Then
i = i + 1
rg2.Item(i) = c
End If
Next
End Sub
六、如何将excel表1的内容通过VBA控件复制到表2和表3的特定位置
插入一个代码:sheets("表2" ).range("c4")=sheets("表1" ).range("B5")sheets("表2" ).range("H4")=sheets("表1" ).range("B5")sheets("表2" ).range("c22")=sheets("表1" ).range("B5")sheets("表2" ).range("H22")=sheets("表1" ).range("B5")sheets("表2" ).range("c6")=sheets("表1" ).range("C5")sheets("表2" ).range("H6")=sheets("表1" ).range("C12")。
。
。以此类推就好了。
转载请注明出处办公知识网 » vba的复制excel表内容
活頁簿檔案之間的工作表複製, 基本上有三個方法:
(一) 整張工作表的複製:
例如要把 Book2.xls 的 sheet3 複製到 Book3 裡, 插入 Sheet2 的前面:
(Book3和 Book2.xls 都是在檔案已開啟的狀態)
Workbooks("Book2.xls").Sheets("Sheet3").Copy before:=Workbooks("Book3").Sheets("Sheet2")
(二) 整張工作表所有儲存格的 "複製-貼上"
例如要把 Book2.xls 的 sheet3 複製到 Book3 的 Sheet2 裡面:
(Book3和 Book2.xls 都是在檔案已開啟的狀態)
Workbooks("Book2.xls").Worksheets("sheet3").Cells.Copy
Workbooks("Book3").Worksheets("sheet2").Paste
(三) 把 Excel 活頁簿當成來源資料庫:
假設要匯入 "C:\Book2.xls" 的 "sheet3", 不需開啟 "C:\Book2.xls" :
Sub 工作表匯入()
ActiveWorkbook.Worksheets.Add
With ActiveSheet.QueryTables.Add(Connection:=Array( _
"OLEDB;Provider=Microsoft.Jet.OLEDB.4.0;Password="""";User ID=Admin;Data Source=C:\Book2.xls;Mode=Share Deny Write;Extended Properties=""H" _
, _
"DR=NO;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OLEDB:Database Password="""";Jet OLEDB:Engine Type=35;Jet OLED" _
, _
"B:Database Locking Mode=0;Jet OLEDB:Global Partial Bulk Ops=2;Jet OLEDB:Global Bulk Transactions=1;Jet OLEDB:New Database Passwo" _
, _
"rd="""";Jet OLEDB:Create System Database=False;Jet OLEDB:Encrypt Database=False;Jet OLEDB:Don't Copy Locale on Compact=False;Jet O" _
, "LEDB:Compact Without Replica Repair=False;Jet OLEDB:SFP=False"), Destination _
:=Range("A1"))
.CommandType = xlCmdTable
.CommandText = Array("Sheet3$")
.Name = "Book2"
.FieldNames = False
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.BackgroundQuery = True
.RefreshStyle
= xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.PreserveColumnInfo = True
.SourceDataFile = "C:\Book2.xls"
.Refresh
BackgroundQuery:=False
End With
End Sub