CODEWITHSUNDEEP
vbaexcel
Jenny
Jenny

Reputation: 451

Extracting data from one workbook, depending on the column Names and pasting it in another workbook

I have two workbook . Book1 and Book2.

I want to copy the Contents of Book1, sheet1 to book2 sheet3.

The data in my sheet1 of book1 starts from row 22, and i want them to be pasted from row 5 for book2 of sheet3.

I have in few cases, where I want to skip the columns and paste the selected columns.

For eg: from bk1, sht1, I want column A to be pasted in Column B of Bk2, sht3 ; Bk1 sht1, Column B pasted in column A of sht3, Column C of Bk1 sht3, in column I of bk2 sht3. Like this.

I tried with a code, where i am looking for column and not the names.

For eg: instead of split(Column A), I would like to have Split("Project Name") and paste them in column B of my sheet. 

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

can anyone tell me how i can do this ? Any lead would be helpful

Upvotes: 0

Views: 93

Answers (2)

CMArg
CMArg

Reputation: 1567

Try the following. Edited according to comments.

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

Upvotes: 1

user8285860
user8285860

Reputation:

This will do what you are asking for, with out all the extra code, once again "keep it simple".

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

Upvotes: 0

Related Questions