简体   繁体   English

VBA将数据从一个工作簿复制到另一个工作簿

[英]VBA copying data from one workbook to another

Im just exploring the VBA and trying to use it for copying a selection of data from one workbook to another. 我只是探索VBA,并试图将其用于将所选数据从一个工作簿复制到另一个工作簿。 The first book 'send' has information between A:D and the number of rows can change. 第一本书“发送”具有A:D之间的信息,并且行数可以更改。 The 'receiver' will have the information collected from many 'send' so this data needs to be copied in below the last information. “接收者”将从许多“发送”中收集信息,因此需要将这些数据复制到最后一个信息的下面。 I found this code below and modified it, but it give me a runtime 9 code and falls at ' lMaxRows_t' Any ideas or help much appreciated 我在下面找到了此代码并对其进行了修改,但它为我提供了运行时9代码,并位于'lMaxRows_t'。

    Sub CopyData()
Dim sBook_t As String
Dim sBook_s As String
Dim sSheet_t As String
Dim sSheet_s As String
Dim lMaxRows_t As Long
Dim lMaxRows_s As Long
Dim sMaxCol_s As String
Dim sRange_t As String
Dim sRange_s As String
sBook_t = "\\scceastfl5\~\tester receiver.xlsx"
sBook_s = "\\scceastfl5\~\tester send.xlsx"
sSheet_t = "Sheet1"
sSheet_s = "Sheet1"
lMaxRows_t = Workbooks(sBook_t).Sheets(sSheet_t).Cells(Rows.Count, "A").End(xlUp).Row
lMaxRows_s = Workbooks(sBook_s).Sheets(sSheet_s).Cells(Rows.Count, "A").End(xlUp).Row
sMaxCol_s = Workbooks(sBook_s).Sheets(sSheet_s).Cells(1, Columns.Count).End(xlToLeft).Address
sMaxCol_s = Mid(sMaxCol_s, 2, InStr(2, sMaxCol_s, "$") - 2)
If (lMaxRows_t = 1) Then
sRange_t = "A1:" & sMaxCol_s & lMaxRows_s
sRange_s = "A1:" & sMaxCol_s & lMaxRows_s
Workbooks(sBook_t).Sheets(sSheet_t).Range(sRange_t) = Workbooks(sBook_s).Sheets(sSheet_s).Range(sRange_s).Value
Else
sRange_t = "A" & (lMaxRows_t + 1) & ":" & sMaxCol_s & (lMaxRows_t + lMaxRows_s - 1)
sRange_s = "A2:" & sMaxCol_s & lMaxRows_s
Workbooks(sBook_t).Sheets(sSheet_t).Range(sRange_t) = Workbooks(sBook_s).Sheets(sSheet_s).Range(sRange_s).Value
End If
End Sub

Maybe like so, this should be easy to edit: 也许是这样,这应该很容易编辑:

Option Explicit

Sub AddToMaster()
'this macro goes IN the master workbook
Dim wsMaster As Worksheet, wbDATA As Workbook
Dim NextRow As Long, LastRow As Long

Set wsMaster = ThisWorkbook.Sheets("Sheet1")
NextRow = wsMaster.Range("A" & Rows.Count).End(xlUp).Row + 1

Set wbDATA = Workbooks.Open("\\scceastfl5\~\tester send.xlsx")

    With wbDATA.Sheets("Sheet1")
        LastRow = .Range("A" & .Rows.Count).End(xlUp).Row
        If LastRow > 19 Then
            .Range("A20:E" & LastRow).Copy
            wsMaster.Range("A" & NextRow).PasteSpecial xlPasteValues
            wsMaster.Range("A" & NextRow).PasteSpecial xlPasteFormats
        End If
    End With

wbDATA.Close False
End Sub

This version goes in the SENDER workbook: 此版本位于SENDER工作簿中:

Option Explicit

Sub SendToMaster()
'this macro goes IN the sender workbook
Dim wsSEND As Worksheet, wbMASTER As Workbook
Dim NextRow As Long, LastRow As Long

Set wsSEND = ThisWorkbook.Sheets("Sheet1")
LastRow = wsSEND.Range("A" & Rows.Count).End(xlUp).Row

Set wbMASTER = Workbooks.Open("\\scceastfl5\~\tester receiver.xlsx")

    With wbMASTER.Sheets("Sheet1")
        NextRow = .Range("A" & .Rows.Count).End(xlUp).Row + 1
        wsSEND.Range("A20:E" & LastRow).Copy
        .Range("A" & NextRow).PasteSpecial xlPasteValues
        .Range("A" & NextRow).PasteSpecial xlPasteFormats
    End With

wbMASTER.Close True     'save and close the master

End Sub
Sub CopyData()
Dim wb1 As Workbook
Dim wb2 As Workbook

'Set workbooks
Set wb1 = Workbooks.Open("c:\Path\of\your\file.xlsx")
Set wb2 = Workbooks.Open("c:\Path\of\your\file1.xlsx")

'clear all data
wb2.Sheets(1).Cells.Clear

'Copy data from wb1 sheet 1 to sheet 1 in wb2
With wb1.Sheets(1)
    .UsedRange.Copy wb2.Sheets(1).range("A1").end(xldown).offset(1,0)
End With

End Sub

声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM