Solved: Copy a Range then Transpose Paste into every other Cell

[JimS]

I'm copying a range of 20 cells (C9:C28) from one Workbook into my Active Workbook, but want to transpose the paste into every other cell (D5, F5, H5, J5, L5, etc... out to AP5).

There is data in the skipped cells (E5, G5, I5, K5, M5, etc.., out to AQ5) that I need to avoid "stepping on".

I will be copying over 200 Ranges from 200 different files so I will be incremanting the Row (5 in this example) as I loop through the 200 files if that makes a difference in the solution.

Any ideas?

As always, Thanks...

JimS

[Kenneth Hobs]

Did you really want to copy and paste or did you just need the value? If you just need the value from a closed workbook, you can do it with:
[VBA]Sub t()
MsgBox GetValue("x:\test", "test.xlsx", "Sheet1", "A1")
End Sub

'=GetValue("c:\files", "budget.xls", "Sheet1", "A1")
Private Function GetValue(path, file, sheet, ref)
' path = "d:\files"
' file = "budget.xls"
' sheet = "Sheet1"
' ref = "A1:R30"

Dim arg As String

If Right(path, 1) <> "\" Then path = path & "\"

If Dir(path & file) = "" Then
GetValue = "file not found"
Exit Function
End If

arg = "'" & path & "[" & file & "]" & sheet & "'!" & _
Range(ref).Range("a1").Address(, , xlR1C1)

GetValue = ExecuteExcel4Macro(arg)
End Function[/VBA]

You can also use this sort of method. After a formula is entered and you are done, get the range then write it back as a Value. You can use a scratchsheet to get the parts needed.
[VBA]Sheet2.Range("A1:H8") = "= 'C:\My Documents\OzGrid\" & "[Book1.xls]Sheet2'!RC"[/VBA]

[p45cal]

Kenneth's first question is all important; if you want to copy over values and formats etc. you'll need the source file to be open, if you want just values then it doesn't need to be opened.
The following is only part of the answer, being one way to copy the right cells to the right places; we need to know how you're going to get the list of files/sheetnames.
Anyway:[VBA]Sub blah()
FileNm = "='C:\Test\My Documents\[test.xls]Sheet1'!"
For destrow = 5 To 7 'three rows of same source data for the time being
sourcerow = 9
For destcolm = 4 To 42 Step 2
With Cells(destrow, destcolm)
.FormulaR1C1 = FileNm & "R" & sourcerow & "C3"
'.Value = .Value 'optional; removes formula.
End With
sourcerow = sourcerow + 1
Next destcolm
Next destrow
End Sub
[/VBA]

[JimS]

Thanks for your responses.

Ken is correct in that I only need the Values (not any formatting). I'm not skilled enough in VBA to figure out how Ken's code is supposed to work, but will continue to try and figure it out.

Below is a chunky piece of code that I have put together that will work (almost).

It references a range name ("files"), which is a list of file names to determine which file to open in the source folder.

The 1st issue is that the source files all have the same Data Validation which is getting copied over and causing the standard error message about duplicate "names" - which I haven't figured out a fix for yet.

PLUS, since I'm actually opening the "input" files I'm worried about memory issues when I have to open 100's of files, not to mention speed.

So if I can do this without actually opening the input files and not copying any formats (data validation/names) I think that would be the best solution. I just can't figure out how Ken's code works.

Thanks again for your help, or any other suggestions...

JimS


[vba]
Sub Import_Data()

Dim myDir As String, r As Range, fn As String, msg As String
Dim x As Integer
Dim c As Integer
Dim w As Integer

myDir = "C:\Test\Test Data Files\"

x = 5

For Each r In Range("files")

fn = Dir(myDir & r.Value)

If fn = "" Then
msg = msg & vbLf & r.Value
Else

With Workbooks.Open(myDir & fn) ' copies Names to Column A, B & C
.Sheets("Name").Range("B7").Copy _
ThisWorkbook.Sheets("Data").Range("A" & x)

.Sheets("Name").Range("B9").Copy _
ThisWorkbook.Sheets("Data").Range("B" & x)

.Sheets("Name").Range("B11").Copy _
ThisWorkbook.Sheets("Data").Range("C" & x)

w = 4

For c = 9 To 28 'copies C9:C28 to D,F,H,J,L,N etc...
.Sheets("Votes").Cells(c, 3).Copy _
ThisWorkbook.Sheets("Data").Cells(x, w)

w = w + 2

Next c


w = 5

For c = 9 To 28 'copies C9:C28 to E,G,I,K,M,O etc...
.Sheets("Votes").Cells(c, 5).Copy _
ThisWorkbook.Sheets("Data").Cells(x, w)

w = w + 2

Next c

End With
x = x + 1

With Workbooks.Open(myDir & fn)
.Close False
End With

End If
Next

If Len(msg) Then
MsgBox "Not found" & msg
End If

Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic


End Sub
[/vba]

[p45cal]

try (untested):[VBA]Sub Import_Data()
Dim myDir As String, r As Range, fn As String, msg As String
Dim x As Long, C As Long, w As Long

myDir = "C:\Test\Test Data Files\"
x = 5
With ThisWorkbook.Sheets("Data")
For Each r In Range("files")
fn = Dir(myDir & r.Value)
If fn = "" Then
msg = msg & vbLf & r.Value
Else
With .Range("A" & x)
.FormulaR1C1 = "='" & myDir & "[" & r.Value & "]" & "Name" & "'!R7C2"
.Value = .Value 'optional; converts formula to value.
End With
With .Range("B" & x)
.FormulaR1C1 = "='" & myDir & "[" & r.Value & "]" & "Name" & "'!R9C2"
.Value = .Value 'optional; converts formula to value.
End With
With .Range("C" & x)
.FormulaR1C1 = "='" & myDir & "[" & r.Value & "]" & "Name" & "'!R11C2"
.Value = .Value 'optional; converts formula to value.
End With
w = 4
For C = 9 To 28 'copies C9:C28 and E9:E28 to D,E,F,G,H etc...
With .Cells(x, w)
.FormulaR1C1 = "='" & myDir & "[" & r.Value & "]" & "Votes" & "'!R" & C & "C3"
.Value = .Value 'optional; converts formula to value.
End With
With .Cells(x, w + 1)
.FormulaR1C1 = "='" & myDir & "[" & r.Value & "]" & "Votes" & "'!R" & C & "C5"
.Value = .Value 'optional; converts formula to value.
End With
w = w + 2
Next C
x = x + 1
End If
Next
If Len(msg) Then
MsgBox "Not found" & msg
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Application.Calculation = xlAutomatic
End Sub[/VBA]

[JimS]

p45cal,

Perfect, just what I needed - thanks for this solution.

Ken,

Thanks for taking the time to look at this.

JimS