Copying 3 columns to another worksheet

[m_in_spain]

Hi again, alas more help is needed!
I am trying to copy selected data from one sheet to another, but only if there is data in column A on the origin sheet.
If there is data in column A and B, then i copy A to C to my destination sheet.
This part, from scratching around on the internet i have managed. Next I need to do the same task over a few more sheets, but copying it to the next available row on my destination sheet.
I have managed to get this to work, but it will only copy column A, I have tried every way i can think of to extend the second (and subsequent) to cover columns A,B & C but i draw blank.
I am quite sure this is possible, and for some with be simple, unfortunately for me it is I who is simple!
Story So far:

Sub CollateUsed()
Dim sIn As Worksheet, sOut As Worksheet, rIn As Range, rOut As Range
Dim inputdata() As Variant
Dim tmpArr(1 To 3) As Variant
Dim i As Long, outcount As Long
Set sIn = Sheets("TRmech")
Set sOut = Sheets("ProjOutput")
Set rIn = sIn.Range("A5:C64")
'Set rIn = sIn.UsedRange
Set rOut = sOut.Range("A1:C1")
inputdata = rIn.Value
outcount = 0
'Reads data from inputdata Array and prints selected values from columns A, B, and C on Output sheet row by row.
For i = 1 To UBound(inputdata, 1)
    If inputdata(i, 1) <> "" Then
    If inputdata(i, 2) <> "" Then
    If inputdata(i, 1) = "" Then End
        outcount = outcount + 1
        tmpArr(1) = inputdata(i, 1)
        tmpArr(2) = inputdata(i, 2)
        tmpArr(3) = inputdata(i, 3)
        rOut.Offset(outcount - 1, 0).Value = tmpArr
        Erase tmpArr
    End If
    End If
Next i
Erase inputdata
'==================DO IT ALL AGAIN DIFFERENT INPUT SHEET
Set sIn = Sheets("TRelec")
Set sOut = Sheets("ProjOutput")
Set rIn = sIn.Range("A5:C64")
'Set rIn = sIn.UsedRange
Set rOut = sOut.Range("A" & Rows.Count).End(xlUp).Offset(1)
inputdata = rIn.Value
outcount = 0
'Reads data from inputdata Array and prints selected values from columns A, B, and C on Output sheet row by row.
For i = 1 To UBound(inputdata, 1)
    If inputdata(i, 1) <> "" Then
    'If inputdata(i, 2) <> "" Then
    If inputdata(i, 1) = "" Then End
        outcount = outcount + 1
        tmpArr(1) = inputdata(i, 1)
        'tmpArr(2) = inputdata(i, 2)
        'tmpArr(3) = inputdata(i, 3)
        rOut.Offset(outcount - 1, 0).Value = tmpArr
        Erase tmpArr
    End If
    'End If
Next i
Erase inputdata
End Sub

Any guidance greatly appreciated

 

[Fluff]

How about

Sub minspain()
   Dim Ary As Variant, Nary As Variant, Shtary As Variant
   Dim r As Long, nr As Long, i As Long
   Dim WsOut As Worksheet
   
   Set WsOut = Sheets("ProjOutput")
   Shtary = Array("TRmech", "TRelec")
   
   For i = 0 To UBound(Shtary)
      Ary = Sheets(Shtary(i)).Range("A5:C64").Value2
      For r = 1 To UBound(Ary)
         If Ary(r, 1) <> "" And Ary(r, 2) <> "" Then
            nr = nr + 1
            Nary(nr, 1) = Ary(r, 1)
            Nary(nr, 2) = Ary(r, 2)
            Nary(nr, 3) = Ary(r, 3)
         End If
      Next r
      WsOut.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(nr, 3).Value = Nary
      nr = 0
      Erase Nary
   Next i
End Sub

 

[m_in_spain]

How about

Sub minspain()
   Dim Ary As Variant, Nary As Variant, Shtary As Variant
   Dim r As Long, nr As Long, i As Long
   Dim WsOut As Worksheet
  
   Set WsOut = Sheets("ProjOutput")
   Shtary = Array("TRmech", "TRelec")
  
   For i = 0 To UBound(Shtary)
      Ary = Sheets(Shtary(i)).Range("A5:C64").Value2
      For r = 1 To UBound(Ary)
         If Ary(r, 1) <> "" And Ary(r, 2) <> "" Then
            nr = nr + 1
            Nary(nr, 1) = Ary(r, 1)
            Nary(nr, 2) = Ary(r, 2)
            Nary(nr, 3) = Ary(r, 3)
         End If
      Next r
      WsOut.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(nr, 3).Value = Nary
      nr = 0
      Erase Nary
   Next i
End Sub

Hi,
Thanks for reply, I am getting a type mismatch at:

 Nary(nr, 1) = Ary(r, 1)

I notice, by hovering over the following two line i am getting same type mismatch at nr, 2 and nr, 3
I checked twice to make sure i copied your code correctly
Thanks for helping

 

[Fluff]

Ok, how about

Sub minspain()
   Dim Ary As Variant, Nary As Variant, Shtary As Variant
   Dim r As Long, nr As Long, i As Long
   Dim WsOut As Worksheet
   
   Set WsOut = Sheets("ProjOutput")
   Shtary = Array("pcode", "TRelec")
   
   For i = 0 To UBound(Shtary)
      Ary = Sheets(Shtary(i)).Range("A5:C64").Value2
      ReDim Nary(1 To UBound(Ary), 1 To 3)
      For r = 1 To UBound(Ary)
         If Ary(r, 1) <> "" And Ary(r, 2) <> "" Then
            nr = nr + 1
            Nary(nr, 1) = Ary(r, 1)
            Nary(nr, 2) = Ary(r, 2)
            Nary(nr, 3) = Ary(r, 3)
         End If
      Next r
      WsOut.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(nr, 3).Value = Nary
      nr = 0
   Next i
End Sub

 

[m_in_spain]

Ok, how about

Sub minspain()
   Dim Ary As Variant, Nary As Variant, Shtary As Variant
   Dim r As Long, nr As Long, i As Long
   Dim WsOut As Worksheet
  
   Set WsOut = Sheets("ProjOutput")
   Shtary = Array("pcode", "TRelec")
  
   For i = 0 To UBound(Shtary)
      Ary = Sheets(Shtary(i)).Range("A5:C64").Value2
      ReDim Nary(1 To UBound(Ary), 1 To 3)
      For r = 1 To UBound(Ary)
         If Ary(r, 1) <> "" And Ary(r, 2) <> "" Then
            nr = nr + 1
            Nary(nr, 1) = Ary(r, 1)
            Nary(nr, 2) = Ary(r, 2)
            Nary(nr, 3) = Ary(r, 3)
         End If
      Next r
      WsOut.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(nr, 3).Value = Nary
      nr = 0
   Next i
End Sub

Genius! Thanks you.
If i ever understand 1/1000th of what you can do with excel I shall have arrived!
Many thanks
(I did spot the Shtary = Array("pcode", "TRelec") but replaced the"pcode" with my sheet name, and it worked.
Again, many thanks

 

[Fluff]

You're welcome & thanks for the feedback.

 

[m_in_spain]

However, like the proverbial bad penny, here i am again! I now discover that when i check for <>"" this works fine for rows that are actually blank, but.. of course i hace formulae in some cells which make it seem blank! Are you able to help me further, am happy to post a new thread if that is the best way forward
Thanks again

 

[Fluff]

What is the formula?

 

[m_in_spain]

Hi
It is
If Ary(r, 1) <> "" And Ary(r, 2) <> "" Then
nr = nr + 1
Nary(nr, 1) = Ary(r, 1)
Nary(nr, 2) = Ary(r, 2)
Nary(nr, 3) = Ary(r, 3)

i receive Runtime Error '1004' Application-defined or objct-defined error
I checked the fault was that by removin a formula in the cell that made it look blank

 

[Fluff]

That is VBA code, not a formula, what is the formula in the cell?