# Copy and Transpose Macro VBA

I have a macro where I open several text files to copy and transpose several columns into my worksheet. As it is now this actually works. I am right now opening the text file, copying a column, going back to my original worksheet pasting and transposing the data, then switching back and forward between the two sheets until all relevant columns have been copied, then I close down the text file and open a new one...

I figured it could probably be optimized if I understood VBA a little better.

My question is: can I save the column data as ranges instead and then copy it all at once and pasting and transposing it all at once as well? Or is there any other ways to improve my macro?

I have shown an example of my code below hope you can make sense of it (I have only shown the import of one column, the rest follow the same code):

Sub Hent_og_Transponer()

Dim f As String

f = ActiveWorkbook.Name

'Select files for import

Dim K As Integer
FILOPEN = Application.GetOpenFilename("Files (*.txt; *.jpg; *.bmp; *.tif),*.chr; *_chr.txt; *chr.txt; *.tif", _
, "Select Picture to Import", MultiSelect:=True)

If IsArray(FILOPEN) Then
For K = LBound(FILOPEN) To UBound(FILOPEN)
Application.ScreenUpdating = False
Workbooks.OpenText FileName:=FILOPEN(K), _
Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=True, _
Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 2), _
TrailingMinusNumbers:=True

'Save name of file opened

Dim z As String

z = ActiveWorkbook.Name

Windows(Left(z, Len(z))).Activate

'Copy Temperature Data from opened file

Range("A1").Select

'Find row with temp data

Dim RowTemp1 As Range
Dim RowTemp As Integer

Set RowTemp1 = Range("B:B").Find("f in Hz", SearchOrder:=xlRows, MatchCase:=False)
If Not RowTemp1 Is Nothing Then  ' if findrow is something (Prevents Errors)
RowTemp = RowTemp1.Row      ' set FirstRow to the first time a match is found
End If

ActiveSheet.Cells(RowTemp + 1, 1).Select
Range(Selection, Selection.End(xlDown)).Select

Selection.Copy

'Go back to DMA sheet

Windows(Left(f, Len(f))).Activate

'Paste and Transpose Temp Data

If IsEmpty(ActiveSheet.Cells(4, 2).Value) = True Then
ActiveSheet.Cells(4, 1).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True

ActiveSheet.Cells(4 + 5 + Range("A2").Value, 1).Select
ActiveCell.Offset(0, 1).Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues,

Operation:=xlNone, SkipBlanks _
:=False, Transpose:=True
End If
'Here I continue to do the same with different columns...

Next K
End If
End Sub


Textfile:

Date / Time / Version: 29.03.2019 / 7:21:01 / HAAKE RheoWin 4.82.0001 Substance / Sample no: pasta mix vége run1 / pasta mix vége run1

;f in Hz;|G*| in Pa;tan(delta) in -;Fn in N;h in mm; 1|1;10,0;1736000;0,650;0,505;1,05; 1|2;5,62;1431000;0,603;0,486;1,05; 1|3;3,16;1203000;0,575;0,510;1,05; 1|4;1,78;1016000;0,561;0,481;1,05; 1|5;1,00;857000;0,565;0,471;1,05; 1|6;0,562;722300;0,585;0,447;1,05; 1|7;0,316;608300;0,619;0,437;1,05; 1|8;0,178;505200;0,664;0,422;1,05; 1|9;0,100;413900;0,715;0,383;1,05; 2|1;0,0562;328400;0,771;0,338;1,05; 2|2;0,0316;264700;0,827;0,297;1,05; 2|3;0,0178;208000;0,871;0,252;1,05; 2|4;0,0100;159600;0,907;0,203;1,05; 2|5;0,00562;129800;0,916;0,158;1,05; 2|6;0,00316;98510;0,913;0,114;1,05;

• The process can be improved. Do you have an example text file? Why do you have image filters in your file dialog? – TinMan Apr 6 at 19:59
• Bad formatting/indenting, using GoTos, incomplete routine (where is the sub/function signature?), really crazy code that shows very little thought when copying someone else's code (Left(z, Len(z))), missing labels (Data2:) which in themselves is real code stink, activating windows for what purpose?. I am not going to review this, because my basic first comment is to scrap the code and then rewrite the logic. – AJD Apr 7 at 0:12
• @TinMan , the image part is a mistake. I got this bit of code of somewhere and as it worked I did not consider that the text was wrong. But that should be an easy fix. I have added the textfile below the code - did not know how to attach it. – Lonnie Apr 7 at 6:26
• @ADJ The GoTo code is something I was trying to implement as the first two columns I import from each textfile will be the same, so figured I would skip this part when I imported the second text file etc... I have removed the code as this part actually did not run yet. – Lonnie Apr 7 at 6:28
• Your code does not work with this data "as is". You need to upload the file to a service like Google Drive or Dropbox and then share the link. – TinMan Apr 7 at 10:12