Question

我有两本工作簿。 Book1和Book2。

我想将Book1，sheet1的内容复制到book2 sheet3。

book1的sheet1中的数据从第22行开始，我希望它们从第5行粘贴到sheet3的book2。

在少数情况下，我想跳过列并粘贴所选列。

例如：从bk1，sht1，我希望将A列粘贴在Bk2的B列中，sht3; Bk1 sht1，B列粘贴在sht3的A列，Bk1 sht3的C列，bk2 sht3的第I列。像这样。

我尝试使用代码，我在寻找列而不是名称。

对于例如：而不是拆分（A列），我想要拆分（＆＃34;项目名称＆＃34;）并将它们粘贴到我的工作表的B列。

Sub ExtractBU()
Dim x As Workbook
Dim y As Workbook
Dim Val As Variant
Dim filename As String
Dim LastCell As Range
Dim LastRow As Long

CopyCol = Split("A,B,C,D,E,F,H,I,K,L,M,O,P", ",")
LR = Cells(Rows.Count, 1).End(xlUp).Row
LC = Cells(1, Columns.Count).End(xlToLeft).Column
LCell = ActiveWindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Address
LCC = ActiveWindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Column
lcr = ActiveWindow.RangeSelection.SpecialCells(xlCellTypeLastCell).Row

Set y = ThisWorkbook
    Dim path1, Path2
path1 = ThisWorkbook.Path
Path2 = path1 & "\Downloads"
Set x = Workbooks.Open(filename:=Path2 & "\Report.xlsx")

For Count = 0 To UBound(CopyCol)
  Set temp = Range(CopyCol(Count) & "22:" & CopyCol(Count) & lcr)
  If Count = 0 Then
    Set CopyRange = temp
  Else
    Set CopyRange = Union(CopyRange, temp)
  End If
Next

CopyRange.Copy
y.Sheets("BU").Paste y.Sheets("BU").Range("A4")
Application.CutCopyMode = False
x.Close
End Sub

谁能告诉我怎么做到这一点？任何领导都会有所帮助

Answer 1

尝试以下方法。 根据评论进行编辑。

Sub ExtractBU()
    Dim DestinationWB As Workbook
    Dim OriginWB As Workbook
    Dim path1 As String
    Dim FileWithPath As String
    Dim LastRow As Long, i As Long, LastCol As Long
    Dim TheHeader As String
    Dim cell As Range

    Set OriginWB = ThisWorkbook
    path1 = OriginWB.Path
    FileWithPath = path1 & "\Downloads\Report.xlsx"
    Set DestinationWB = Workbooks.Open(filename:=FileWithPath)


    LastRow = OriginWB.Worksheets("BU").Cells(Rows.Count, 1).End(xlUp).Row
    LastCol = OriginWB.Worksheets("BU").Cells(22, Columns.Count).End(xlToLeft).Column

    For i = 1 To LastCol
        'get the name of the field (names are in row 22)
        TheHeader = OriginWB.Worksheets("BU").Cells(22, i).Value

        With DestinationWB.Worksheets("BU").Range("A4:P4")
            'Find the name of the field (TheHeader) in the destination (in row 4)
            Set cell = .Find(TheHeader, LookIn:=xlValues)
        End With

        If Not cell Is Nothing Then
            OriginWB.Worksheets("BU").Range(Cells(23, i), Cells(LastRow, i)).Copy Destination:=DestinationWB.Worksheets("BU").Cells(5, cell.Column)
        Else
            'handle the error
        End If
    Next i

    'DestinationWB.Close SaveChanges:=True

End Sub

Answer 2

这将满足您的要求，不再需要所有额外的代码，并且保持简单＆＃34;。

Sub test()
Dim lRow As Long

Workbooks.Open Filename:=ThisWorkbook.Path & "\Downloads" & "\Report.xlsx"

lRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row

    ThisWorkbook.Range("A22:P" & lRow).Copy Destination:=Workbooks("Report.xlsx").Worksheets("Sheet3").Range("A5")

End Sub

从一个工作簿中提取数据，具体取决于列名称并将其粘贴到另一个工作簿中

2 个答案: