VBA:将设置范围数据从一个工作簿转置到另一个工作簿

我的项目涉及到从一个文件夹中的文件复制数据到一个excel。 该文件夹中的文件有行中的数据,我需要将数据转置到一个Excel(数据库Excel)。 我发现了一些非常接近我需要的代码,我正试图修改那些代码来为我工作。 它看起来像我只需要修改在下面的代码的目标,但我无法得到任何调整工作。

完整的代码可以在这里find: http : //www.rondebruin.nl/win/s3/win008.htm

我错过了什么将数据从行转移到列?

If Not sourceRange Is Nothing Then SourceCcount = sourceRange.Columns.Count If Cnum + SourceCcount >= BaseWks.Columns.Count Then MsgBox "Sorry there are not enough columns in the sheet" BaseWks.Columns.AutoFit mybook.Close savechanges:=False GoTo ExitTheSub Else 'Copy the file name in the first row With sourceRange BaseWks.Cells(1, Cnum). _ Resize(, .Columns.Count).Value = MyFiles(Fnum) End With 'Set the destrange Set destrange = BaseWks.Cells(2, Cnum) 'Set destrange = BaseWks.Range("A" & 1) 'we copy the values from the sourceRange to the destrange With sourceRange Set destrange = destrange. _ Resize(.Rows.Count, .Columns.Count) '.PasteSpecial Paste:=xlValues, Transpose:=True 'destrange.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True End With destrange.Value = sourceRange.Value Cnum = Cnum + SourceCcount End If End If mybook.Close savechanges:=False End If 

请注意,de Bruin没有使用Copy方法。 试试这个(未经testing)

 'Set the destrange Set destrange = BaseWks.Cells(2, Cnum) 'Set destrange = BaseWks.Range("A" & 1) 'we copy the values from the sourceRange to the destrange With SourceRange 'NOTE we reverse the rows and columns Set destrange = destrange. _ Resize(.Columns.count, .Rows.count) End With 'NOTE we transpose the SourceRange. If SourceRange has a huge number of rows, might have to do this manually. destrange.Value = WorksheetFunction.Transpose(SourceRange.Value) 

罗恩,你发布的解决scheme是正确的。 当我更新我的代码时,我有一个错字。 注意。 我还必须进行其他更新,例如创build和交换Rnum的Cnum,这样数据将按行而不是列添加。 那你为了你的时间和快速的回​​应。 我并不是想坚持de Bruin正在使用复制方法,而是试图找出他使用的方法的名字。 我想这并不是真的有一个名字。 他只是使用数组来移动数据。