从一个工作簿中提取数据，根据不同的列名，并在另一个工作簿

Question

粘贴我有两个工作簿。 Book1和Book2。

我想复制第一册的内容，对工作表Sheet1工作表Sheet 3 BOOK2。

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

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

例如：来自bk1，sht1，我想要将A列粘贴到Bk2的列B中，sht3; Bk1 sht1，列b粘贴在sht3的A列中，Bk1 sht3的列C在bk2 sht3的列I中。喜欢这个。

我试图用一个代码，我在哪里寻找列，而不是名字。

对于例如：而不是拆分（列A），我想分割（“项目名称”）并将其粘贴在我的工作表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

这样做可以满足您所要求的所有额外代码，并且可以再次“保持简单”。

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