Excel 工作簿之间的宏复制和粘贴

Question

所以我运行关于使用宏从一个工作簿复制和粘贴到另一个工作簿的问题

我有大约 800 本工作簿，我需要从中复制某些单元格并粘贴到单独的 "tracker" 工作簿中。宏将是执行此操作的最简单方法。

我运行遇到的问题是如何告诉宏 COPYFROM.XLSX 工作簿将发生变化，并且在粘贴时需要粘贴到下一行以免覆盖信息。

你们的任何帮助都会非常有用，谢谢。

Windows("COPYFROM.xlsx").Activate
Range("E39:F39").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("B8").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("F13").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("C8").Select
 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("C13").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("D8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("C15").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("E8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("F17").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("F8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("C17:C18").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("G8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("C27").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("H8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("F21").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("J8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("C21").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("K8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("C23").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("N8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("F25").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("O8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("C37").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("Q8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("F59").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("S8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("F61").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("T8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("F19").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("U8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("C31").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("V8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("F49").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("W8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("F31").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("X8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("F37").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("Y8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("F15").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("AA8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("C37").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("AE8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False


Windows("COPYFROM.xlsx").Activate
Range("F45").Select
Selection.Copy
Windows("Paste.XLSX").Activate
Range("AF8").Select
  Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False



End Sub

Answer 1

类似的东西。假设您沿着第 8 行移动。您应该使用 sheet 名称而不是下面的索引，并使用更有意义的 procedue/variable 名称。

Sub x()

Dim c As Long

Windows("COPYFROM.xlsx").Sheets(1).Range("E39:F39").Copy
With Windows("Paste.XLSX").Sheets(1)
    c = .Cells(8, Columns.Count).End(xlToLeft).Column + 1
    .Cells(8, c).PasteSpecial Paste:=xlPasteValues
End With

'etc

End Sub

Answer 2

像这样：

列出您需要手动或使用（另一个）宏复制的文件。比如像这样
使用此列表，将范围设置为运行到

将数据复制粘贴到下一个空闲行

Sub test()
Dim LastColumn As Long, LastRow As Long, LR As Long, n As Long
Dim Thiswb As Workbook, Openwb As Workbook
Dim Source As Worksheet, wsTO As Worksheet, wsM As Worksheet
Dim FileRange As Range
Dim sSource As String, FileName As String
Dim cell As Variant, FilePath As Variant
Set Thiswb = ThisWorkbook
' Here you put the list of the files you want to copy from
Set Source = Thiswb.Worksheets("Source")
' Here you will paste your data
Set wsTO = Thiswb.Worksheets("HereComesYourData")
' Find the last row of column A. The list of files to look for is in this column
LastRow = Source.Cells(Rows.Count, 1).End(xlUp).Row
'Set the range in which to look
Set FileRange = Source.Range(Source.Cells(2, 1), Source.Cells(LastRow, 1))
n = 2
On Error Resume Next
For Each cell In FileRange    'Run through the whole range
    'Error handling when file or worksheet isn't found
    FilePath = Source.Cells(n, 2).Value
    FileName = Source.Cells(n, 1).Value
    Workbooks.Open (FilePath)
    Set Openwb = Workbooks(FileName)
    'Depending on what you want to copy - declare the correct variable
    Set wsM = Openwb.Worksheets("Master")
    'Calculate last column number of source
    LastColumn = wsM.Cells(1, Columns.Count).End(xlToLeft).Column
    'Calculate last row number of source
    LastRow = wsM.Cells(Rows.Count, 1).End(xlUp).Row
    'Calculate last row number of destination
    LR = wsTO.Cells(Rows.Count, 1).End(xlUp).Row
    'Paste values
    wsTO.Range(wsTO.Cells(LR, 1), wsTO.Cells(LR + LastRow, LastColumn)).Value = wsM.Range(wsM.Cells(2, 1), wsM.Cells(LastRow, LastColumn)).Value
    Openwb.Close SaveChanges:=False
Next cell
End sub

Excel 工作簿之间的宏复制和粘贴

Excel Macro Copy and Paste Between WorkBooks

excel

vba

copy

paste