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

Elvis16

New Member
Joined
Sep 5, 2019
Messages
7
<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:
<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

Well-known Member
Joined
Dec 3, 2018
Messages
7,682
Office Version
2007
Platform
Windows
Try the following macro, it is longer than yours, but it will certainly be faster.

Code:
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
 
Last edited:

Elvis16

New Member
Joined
Sep 5, 2019
Messages
7
Hi Dante Amor,

It worked perfectly fine, i just have a quick question, How can i make the
Code:
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

New Member
Joined
Sep 5, 2019
Messages
7
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

Well-known Member
Joined
Dec 3, 2018
Messages
7,682
Office Version
2007
Platform
Windows
Hi @Elvis16, Try the following, I hope it helps.

Code:
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
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
7,682
Office Version
2007
Platform
Windows
Im glad to help you, thanks for the feedback.
 

Forum statistics

Threads
1,077,674
Messages
5,335,605
Members
399,028
Latest member
greyland

Some videos you may like

This Week's Hot Topics

Top