如何複製列並將粘貼轉換爲包含多個文件的文件夾的新工作簿？

我有一個包含近1,000個.csv文件的文件夾。我想抓住每個這些文件的第二列並轉置 - 將它們粘貼到新的Excel工作簿中，以便數據在一行中。以下是我迄今爲止：如何複製列並將粘貼轉換爲包含多個文件的文件夾的新工作簿？

Sub OpenFiles2() 

    Dim MyFolder As String 
    Dim MyFile As String 

    'Retrieve Target Folder Path From User 
    Set FldrPicker = Application.FileDialog(msoFileDialogFolderPicker) 

    With FldrPicker 
    .Title = "Select A Target Folder" 
    .AllowMultiSelect = False 
    If .Show <> -1 Then GoTo NextCode 
    myPath = .SelectedItems(1) & "\" 
    End With 

    'In Case of Cancel 
    NextCode: 
    myPath = myPath 
    If myPath = "" Then GoTo ResetSettings 

    ResetSettings: 
    'Reset Macro Optimization Settings 
    Application.EnableEvents = True 
    Application.Calculation = xlCalculationAutomatic 
    Application.ScreenUpdating = True 

    Do While myPath <> "" 
    Range(Range("B1"), Range("B1").End(xlDown)).Select 
    Application.CutCopyMode = False 
    Selection.Copy 
    ActiveWorkbook.Close True 
    Windows("Compiled.xlsm").Activate 
    Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Offset(1,0).PasteSpecial Transpose:=True 

    MyFile = Dir 
    Loop 
End Sub

出於某種原因，我不斷收到錯誤選擇性粘貼命令。我也試圖與替代它：

ActiveSheet.PasteSpecial Transpose:=True

而且

Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=  False, Transpose:=True

仍然得到了錯誤。請幫忙。謝謝。

來源

2016-04-29 user6272309

'.Range（「A」＆Rows.Count）''猜測'rows.count'是錯誤的，因爲您沒有指定哪些行在哪個表上。 – findwindow

*我不斷收到錯誤*和*仍然有錯誤*作爲問題描述絕對沒有意義，除非您包含有關您正在獲取哪些**特定錯誤的信息..您在屏幕上有這些信息，就在前面你的眼睛。當你要求我們捐出**我們的時間來解決**你的問題**時，沒有理由不提供給我們。 –

@findwindow - 無需猜測！除了指定表單之外，我***高度推薦閱讀[如何避免使用'.select']（http://stackoverflow.com/questions/10714251/how-to-avoid-using-select -in-excel-vba-macros） – BruceWayne

我會避免使用select和處理值。此代碼將原始值存儲在變量中，然後可以通過在VBA中使用Application.Transpose來關閉活動工作簿並使用該變量中的數據。

用下面的代碼替換Do Loop。

Do While myPath <> "" 
    lastrow = Cells(Rows.Count, 2).End(xlUp).Row 
    x = Range("B1:B" & lastrow).Value 
    ActiveWorkbook.Close True 
    With Worksheets("Sheet1") 
     Range("A" & .Cells(.Rows.Count, 1).End(xlUp).Row + 1). _ 
     Resize(, lastrow).Value = Application.Transpose(x) 
    End With 
    MyFile = Dir 
Loop

來源

2016-04-30 05:30:27

如何複製列並將粘貼轉換爲包含多個文件的文件夾的新工作簿？

回答

相關問題