Excel VBA：從另一個工作簿複製行並粘貼到主工作簿

我在一個文件夾（Test01，Test02，Test03）中有許多相同結構的excel文件。Excel VBA：從另一個工作簿複製行並粘貼到主工作簿

我在同一個文件夾中創建另一個excel文件，需要從其他excel文件（結果）中提取信息。

每個測試文件中都有一個特定列需要複製並粘貼到結果文件的一行中。

我正在嘗試創建一個工具或宏，它可以通過按下一個按鈕，從每個文件中提取相同的列並將其粘貼到結果文件的新行中。

我無法更改測試文件中的任何內容，這應該在不打開每個文件的情況下自動完成。另外新的測試文件將被添加到文件夾（Test04，Test05等），因此該功能應該能夠從新文件中提取。

VBA of Code and Test01 example

Results file

我的代碼不運行，而是，收到運行時錯誤：

Private Sub CommandButton1_Click() 

'Dim info 

'info = isWorkBookopen("C:\Users\Ridwan\Desktop\Test_Excel\Test01.xlsm") 
'If info = False Then 
Workbooks.Open Filename:="C:\Users\Ridwan\Desktop\Test_Excel\Test01.xlsm" 
'End If 

Worksheets(Sheet2).Activate 'This is giving me a runtime error 

Range("C2:C10").Copy 

'Need functions to paste into Results.xlsm 

End Sub

在一個側面說明，我isWorkBookopen功能不起作用，它不認識到它是一種功能。這就是我評論這些評論的原因。

來源

2016-10-11 Ridwan

工作表需要字符串值'工作表（」Sheet2「）。激活' – 2016-10-11 06:54:33

試着讓一切明確

Private Sub CommandButton1_Click() 

Dim wbSource as Workbook 
Dim wbTarget as Workbook  
Dim shSource as Worksheet 
Dim shTarget as Worksheet 

' Open workbook to copy from as readonly 
Set wbSource = Workbooks.Open(Filename:="C:\Users\Ridwan\Desktop\Test_Excel\Test01.xlsm", ReadOnly:=true) 

' The data is copies to this workbook 
Set wbTarget = ThisWorkbook  

' Did you enclose the worksheet name with double quotes? 
' Reference to sheet to copy from 
set shSource = wbSource.Worksheets("Sheet2") 

' Reference to sheet to copy to 
set shTarget = wbTarget.Worksheets("Sheet to copy to") 

' Copy data to first column in target sheet 
shSource.Range("C2:C10").Copy Destination:= shTarget.Cells(1,1) 

End Sub

這樣你就不必使用像激活報表時容易出錯在某些情況下。

來源

2016-10-11 06:54:10 Barry

設置wbTarget = Workbooks.Open（」C：\ Users \ khanr1 \ Desktop \ Test_Excel \ Results.xlsm「）當我使用這一行時，它問我是否要重新打開該文件。如果我說是，它會重新打開，代碼只是從開始到這一行循環。如果我說'不'，那麼它會產生運行時錯誤。 – Ridwan

我的錯誤。您可以從Results.xlsm中運行代碼。您不必打開此工作簿。我修改了代碼。我已將其更改爲'Set wbTarget = ThisWorkbook' – Barry

非常感謝Barry！現在你會碰巧知道如何在複製後將列轉置爲一行？ – Ridwan

看到不同的用途調用表：

Private Sub CommandButton1_Click() 

Dim wB As Workbook 
Dim wS As Worksheet 

Set wB = Workbooks.Open(Filename:="C:\Users\Ridwan\Desktop\Test_Excel\Test01.xlsm") 


Set wS = wB.Sheets("SheetName") 'Name of the sheet in Excel 
''OR 
'Set wS = wB.Sheet2 'Name that you'll see in VBE in parenthesis 

wS.Range("C2:C10").Copy 

Dim wB2 As Workbook 
Dim wS2 As Worksheet 
Dim rG As Range 

'if Results.xlsm as already open 
Set wB2 = Workbooks("Results.xlsm") 
Set wS2 = wB2.Sheets("Sheet1") 
Set rG = wS2.Range("B2") 
rG.Paste 

End Sub

來源

2016-10-11 07:04:39 R3uK

工作簿（「結果。 XLSM 「）。表（」工作表Sheet 「）。範圍（」 B2" ）。粘貼當我調試它時，這條線似乎不被識別。嘗試下面的代碼時遇到同樣的問題。我認爲「工作簿」沒有得到承認。 – Ridwan

@Ridwan：看到編輯，它應該幫助你找到錯誤的有罪部分。當您啓動代碼時，您的工作簿「Results.xlsm」是否已經打開？ – R3uK

，因爲你說「這應該是自動，而無需打開每個文件來完成。」，你可以試試這個：

Option Explicit 

Sub main() 
    Dim fso As New FileSystemObject 
    Dim testFolder As Folder 
    Dim f As File 
    Dim i As Long 

    Set testFolder = fso.GetFolder("C:\Users\Ridwan\Desktop\Test_Excel") 
    With Worksheets("Results") 
     For Each f In testFolder.Files 
      If Left(f.Name, 4) = "Test" Then 
       If fso.GetExtensionName(f.Path) = "xlsm" Then 
        With .Cells(.Rows.Count, 1).End(xlUp).Offset(1) 
         .Value = f.Name 
         i = 0 
         Do 
          i = i + 1 
          .Offset(, i).Formula = "='" & testFolder.Path & "\[" & f.Name & "]Sheet1'!C" & i + 1 
         Loop While .Offset(, i) <> 0 
         .Offset(, i).ClearContents 
         With Range(.Offset(, 1), .Offset(, 1).End(xlToRight)) 
          .Value = .Value 
         End With 
        End With 
       End If 
      End If 
     Next f 
    End With 
End Sub

它需要「Microsoft腳本運行」引用添加到您的項目（工具 - >引用，然後直到你看到庫向下滾動列表框，勾選複選框，在其左「，然後按」確定「）

來源

2016-10-11 07:58:40 user3598756

Excel VBA：從另一個工作簿複製行並粘貼到主工作簿

回答

相關問題