How to copy values from one workbook sheet to another, based on criterias ?

[Elvis16]

<button title="This question does not show any research effort; it is unclear or not useful" class="js-vote-down-btn grid--cell s-btn s-btn__unset c-pointer" aria-pressed="false" style="background-attachment: scroll; background-clip: border-box; background-color: transparent; background-image: none; background-origin: padding-box; background-position-x: 0%; background-position-y: 0%; background-repeat: repeat; background-size: auto; border-bottom-color: rgb(187, 192, 196); border-bottom-left-radius: 3px; border-bottom-right-radius: 3px; border-bottom-style: none; border-bottom-width: 0px; border-image-outset: 0; border-image-repeat: stretch; border-image-slice: 100%; border-image-source: none; border-image-width: 1; border-left-color: rgb(187, 192, 196); border-left-style: none; border-left-width: 0px; border-right-color: rgb(187, 192, 196); border-right-style: none; border-right-width: 0px; border-top-color: rgb(187, 192, 196); border-top-left-radius: 3px; border-top-right-radius: 3px; border-top-style: none; border-top-width: 0px; box-shadow: none; box-sizing: border-box; color: rgb(187, 192, 196); cursor: pointer; display: block; font-family: Arial,"Helvetica Neue",Helvetica,sans-serif; font-size: 13px; font-size-adjust: none; font-stretch: normal; font-style: normal; font-variant: normal; font-weight: 400; line-height: 16.46px; margin-bottom: 2px; margin-left: 2px; margin-right: 2px; margin-top: 2px; outline-color: invert; outline-style: none; outline-width: 0px; padding-bottom: 0px; padding-left: 0px; padding-right: 0px; padding-top: 0px; position: relative; text-align: center; text-decoration: none;" aria-label="down vote" data-selected-classes="fc-theme-primary"><svg xmlns="http://www.w3.org/2000/svg" class="svg-icon m0 iconArrowDownLg" aria-hidden="true" style="box-sizing: border-box; margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px; vertical-align: bottom;" viewBox="0 0 36 36" width="36" height="36" /></button> <button title="This is one of your favorite questions (click to undo)" class="js-favorite-btn s-btn s-btn__unset c-pointer py8 fc-yellow-600" aria-pressed="true" style="background-attachment: scroll; background-clip: border-box; background-color: transparent; background-image: none; background-origin: padding-box; background-position-x: 0%; background-position-y: 0%; background-repeat: repeat; background-size: auto; border-bottom-color: rgb(220, 176, 0); border-bottom-left-radius: 3px; border-bottom-right-radius: 3px; border-bottom-style: none; border-bottom-width: 0px; border-image-outset: 0; border-image-repeat: stretch; border-image-slice: 100%; border-image-source: none; border-image-width: 1; border-left-color: rgb(220, 176, 0); border-left-style: none; border-left-width: 0px; border-right-color: rgb(220, 176, 0); border-right-style: none; border-right-width: 0px; border-top-color: rgb(220, 176, 0); border-top-left-radius: 3px; border-top-right-radius: 3px; border-top-style: none; border-top-width: 0px; box-shadow: none; box-sizing: border-box; color: rgb(220, 176, 0); cursor: pointer; display: block; font-family: Arial,"Helvetica Neue",Helvetica,sans-serif; font-size: 13px; font-size-adjust: none; font-stretch: normal; font-style: normal; font-variant: normal; font-weight: 400; line-height: 16.46px; margin-bottom: 0px; margin-left: 0px; margin-right: 0px; margin-top: 0px; outline-color: invert; outline-style: none; outline-width: 0px; padding-bottom: 8px; padding-left: 0px; padding-right: 0px; padding-top: 8px; position: relative; text-align: center; text-decoration: none;" aria-label="favorite (1)" data-selected-classes="fc-yellow-600"> <svg xmlns="http://www.w3.org/2000/svg" class="svg-icon iconStar" aria-hidden="true" style="box-sizing: border-box; vertical-align: bottom;" viewBox="0 0 18 18" width="18" height="18">
</svg></button>

I have the Code that copies the values and gives me the values but not the one that i Need. I feel that I am Close but something is missing. The Code copies the whole worksheet of the workbook and i Need the values that meet the criterias.
I have this main workbookand i want to take Information from different workbooks which have the same Format, for example this and I want, in the main workbook, to paste the values in some range based on the criterias in the first three columns ("SSL";"Baureihe";"Produktionsjahr")

This is the Code that i have done till now
<code>

<code>
    Sub Transfer ()

    Dim SSl As String
    Dim Baureihe As String
    Dim Produktionsjahr As String
    Dim fileName As String
    Dim Tfile As Workbook
    Dim shData As Worksheet, shOutput As Worksheet
    Dim rg As Range, ra As Range
    Dim i As Long, row As Long, j As Long
    Set shData = ThisWorkbook.Worksheets("Transponieren")

    filename = Application.getOpenFilename("Excel file (*.xlsm),*.xlsm", , "Select File")

    If filename = Empty then
     Exit Sub
    End If

    Set Tfile = Application.Workbooks.Open(filename)
    Set shOutput = Tfile.Worksheets("Transponieren")
    Set rg = shData.Range("A1").CurrentRegion
    Set ra = shOutput.range("A1").CurrentRegion


    row = 2

    For i = 2 To rg.Rows.Count

            SSL = Sheets("Transponieren").Cells(i, 1).Value
            Baureihe = Sheets("Transponieren").Cells (i , 2).Value
            Produktionsjahr = Sheets("Transponieren") .Cells(i, 3).Value

        For j = 2 To ra.Rows.Count

            If ra.Cells(j, 1).Value = SSL And _
            ra.Cells(j, 2).Value = Baureihe And _
            ra.Cells(j, 3).Value = Produktionsjahr Then

   Tfile.Sheets("Transponieren").Range("A" & i & ":E" & i).Copy _ 
  Destination:=ThisWorkbook.Sheets("Transponieren").Range("K" & j & ":O" & j)

     row = row + 1
     Application.CutCopyMode = False

            End if
        Next j
    Next i

    End Sub</code>

</code></pre>I am new at vba Excel, i tried various way but i can't seem to see why this Code doesn't copy only the values that i Need but it copies the whole sheet and it pastes in the given range. Please help !Thanks in Advance.
<strike></strike>


​

​

<strike></strike>

 

[DanteAmor]

Try the following macro, it is longer than yours, but it will certainly be faster.

Sub transfer()
  Dim fileName As Variant, a() As Variant, b() As Variant, c As Variant, i As Long, j As Long
  Dim sh1 As Worksheet, wb2 As Workbook, sh2 As Worksheet
  '
  Application.ScreenUpdating = False
  Set sh1 = Sheets("Transponieren")
  fileName = Application.GetOpenFilename("Excel file (*.xlsm),*.xlsm", , "Select File")
  If fileName = False Then Exit Sub
  Set wb2 = Application.Workbooks.Open(fileName)
  Set sh2 = wb2.Sheets("Transponieren")
  '
  a = sh1.Range("A2:C" & sh1.Range("A" & Rows.Count).End(xlUp).row)
  b = sh2.Range("A2:E" & sh2.Range("A" & Rows.Count).End(xlUp).row)
  ReDim c(1 To UBound(a), 1 To 5)
  For i = 1 To UBound(a)
    For j = 1 To UBound(b)
      If a(i, 1) = b(j, 1) And a(i, 2) = b(j, 2) And a(i, 3) = b(j, 3) Then
        c(i, 1) = b(j, 1)
        c(i, 2) = b(j, 2)
        c(i, 3) = b(j, 3)
        c(i, 4) = b(j, 4)
        c(i, 5) = b(j, 5)
        Exit For
      End If
    Next
  Next
  wb2.Close False
  sh1.Range("K2").Resize(UBound(a), 5).Value = c
End Sub

 

[Elvis16]

Hi Dante Amor,

It worked perfectly fine, i just have a quick question, How can i make the

c(i, 4) = b(j ,4)

start on the range K2. I tried removing the rest of the Code c-s and moving the range Forward , instead of K2 to do it on D2 but then it erases the rest of the datas in the current sheet.

Thankfully,
Elvis

 

[Elvis16]

Never mind, i fixed it. Thanks a lot tho.

Bests

 

[Elvis16]

I just Need one more Thing, it works the Code perfectly fine now. I just Need when i copy the datas ene then i paste them i Need to create a new column in E and paste them there. So each time when i paste the data it should be pasted in that form.
Thanks again.

 

[DanteAmor]

Hi @Elvis16, Try the following, I hope it helps.

Sub transfer()
  Dim fileName As Variant, a() As Variant, b() As Variant, c As Variant, i As Long, j As Long
  Dim sh1 As Worksheet, wb2 As Workbook, sh2 As Worksheet
  '
  Application.ScreenUpdating = False
  Set sh1 = Sheets("Transponieren")
  fileName = Application.GetOpenFilename("Excel file (*.xlsm),*.xlsm", , "Select File")
  If fileName = False Then Exit Sub
  Set wb2 = Application.Workbooks.Open(fileName)
  Set sh2 = wb2.Sheets("Transponieren")
  '
  a = sh1.Range("A2:C" & sh1.Range("A" & Rows.Count).End(xlUp).row)
  b = sh2.Range("A2:E" & sh2.Range("A" & Rows.Count).End(xlUp).row)
  ReDim c(1 To UBound(a), 1 To 5)
  For i = 1 To UBound(a)
    For j = 1 To UBound(b)
      If a(i, 1) = b(j, 1) And a(i, 2) = b(j, 2) And a(i, 3) = b(j, 3) Then
        c(i, 1) = b(j, 1)
        c(i, 2) = b(j, 2)
        c(i, 3) = b(j, 3)
        c(i, 4) = b(j, 4)
        c(i, 5) = b(j, 5)
        Exit For
      End If
    Next
  Next
  wb2.Close False
[COLOR=#0000ff]  sh1.Columns("E:I").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove[/COLOR]
[COLOR=#0000ff]  sh1.Range("E2").Resize(UBound(a), 5).Value = c[/COLOR]
End Sub

 

[Elvis16]

Thanks a lot, it really helped.
Best Regards,

 

[DanteAmor]

Im glad to help you, thanks for the feedback.