Question

我有两个工作簿，源工作簿和目标工作簿。

我想将包含来自源工作簿的数据的特定列（A，C; D; E; F; G; K; AP; AV; AW; AX）复制到列（A到E）中的目标工作簿。我已经在页面中搜索过，可以找到如下代码

Sub Extract()

Dim x As Workbook
Dim y As Workbook
Dim Value As Variant


Set y = ThisWorkbook 
Set x = Workbooks.Open("D:\data\Jenny_Work.xlsx")

Value = x.Sheets("Work_Jenny").Range("A1").Value
y.Sheets("Sheet1").Range("A1").Value = Value

x.Close

End Sub

如果您能按照上述标准建议我，那就太棒了提前感谢

Answer 1

请注意，工作表与工作簿不同，因为这会造成混淆。工作簿/ Excel文件可以包含多个工作表/工作表，而不是相反。

这里说的是你的代码：

Sub RunMe()
Dim lRow, lCol As Integer

Sheets("Master").Select
lRow = Range("A" & Rows.Count).End(xlUp).Row
lCol = Cells(1, Columns.Count).End(xlToLeft).Column

For Each cell In Range(Cells(1, "B"), Cells(1, lCol))
    Union(Range("A1:A" & lRow), Range(Cells(1, cell.Column), Cells(lRow, cell.Column))).Copy
    Workbooks.Add
    Range("A1").PasteSpecial
    ActiveWorkbook.SaveAs Filename:= _
    "C:\YourMap\" & cell.Value & ".xls" 'You might want to change the extension (.xls) according to your excel version
    ActiveWorkbook.Close
Next cell

Application.CutCopyMode = False
End Sub

只需在代码中查看文件扩展名（粘贴后查找绿色文字。）。

Answer 2

试试这个

它对我有用！

 Sub Extract()

Dim x As Workbook
Dim y As Workbook
Dim Value As Variant


Set y = ThisWorkbook
Set x = Workbooks.Open("G:\Book1.xlsm")

lRow = x.Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
dRow = y.Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row


Union(y.Worksheets("Sheet1").Range("A1:A" & dRow), y.Worksheets("Sheet1").Range("B1:B" & dRow)).Copy
x.Worksheets("Sheet1").Range("A" & lRow).PasteSpecial xlPasteAll

Application.CutCopyMode = False

x.Save

End Sub

从另一个工作簿中提取特定列并复制到目标工作簿

2 个答案: