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>
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
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:
Upvote 0
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
 
Upvote 0
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.
 
Upvote 0
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
 
Upvote 0

Forum statistics

Threads
1,213,521
Messages
6,114,109
Members
448,548
Latest member
harryls

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top