![](/img/trans.png)
[英]VBA Copy, paste, and transpose data from one workbook to other workbook
[英]VBA - How to copy all data from other workbook and paste it in last row
我想从一个工作簿中复制数据,然后将其粘贴到另一个没有标题的工作簿的最后一行中。
例如:
Workbook1 Workbook2
**Color** | **Animals** | Fruits **Color** | **Animals**| **Fruits**
yellow | elephant | apple black | pig | mango
blue | girrafe | banana white | dog | grapes
现在我想要的是工作簿中的所有数据都将粘贴在worbk2下而没有标题...
Workbook1
**Colors** | **Animal** | **Fruits**
yellow | elephant | apple
blue | girrafe | banana
black | pig | mango
white | dog | grapes
有人可以帮忙吗 这是我的代码。
Public Sub sample1()
Dim file1 As Excel.Workbook
Dim file2 As Excel.Workbook
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Dim CopyRange As Range
'Open both workbooks first:
Set file1 = Workbooks.Open(TextBox1.Text)
Set file2 = Workbooks.Open(TextBox2.Text)
Set Sheet1 = file1.Sheets(1)
Set Sheet2 = file2.Sheets(1)
lngLastCol = Sheet1.Cells(1, 256).End(xlToLeft).Column
lngLastRow = Sheet1.Range("A" & Sheet1.Rows.Count).End(xlUp).Row
varArray = Sheet1.Range(Sheet1.Cells(2, 1), Sheet1.Cells(lngLastRow, lngLastCol)).Value
Set CopyRange = Sheet1.Range("A1:A" & lngLastRow)
CopyRange.EntireRow.Copy Sheet1.Cells(Rows.Count, 1).End(xlUp)(2)
'Now, copy what you want from :
file1.Sheets("sheet1").CopyRange.EntireRow.Copy Sheet1.Cells(Rows.Count, 1).End(xlUp)(2)
'Now, paste to worksheet:
file2.Sheets("sheet1").Range("B1").PasteSpecial
'Close 1-2:
file2.Save
file1.Close
file2.Close
Dim Sheet1 As Worksheet
Dim Sheet2 As Worksheet
Dim rng As Range
Set Sheet1 = Workbooks.Open(TextBox1.Text).Sheets(1)
Set Sheet2 = Workbooks.Open(TextBox2.Text).Sheets(1)
Set rng = Sheet1.Range("A1").CurrentRegion 'assuming no blank rows/column
Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1, rng.Columns.Count) 'exclude header
Sheet2.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize( _
rng.Rows.Count, rng.Columns.Count).Value = rng.Value
Sheet2.Parent.Close True 'save changes
Sheet1.Parent.Close False 'don't save
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.