Question

我正在探索VBA并尝试使用它将一组数据从一个工作簿复制到另一个工作簿。第一本书“发送”在A：D之间有信息，行数可以改变。 “接收者”将从许多“发送”中收集信息，因此需要将这些数据复制到最后信息的下方。我在下面找到了这个代码并对其进行了修改，但它给了我一个运行时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

Answer 1

也许是这样，这应该很容易编辑：

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

此版本包含在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

Answer 2

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

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

2 个答案: