VBA選擇匹配值的列並將數據復制到另一個工作簿

Question

我有兩個Excel工作簿， rh和summary 。 我在摘要中有代碼可以檢查rh文件以根據其中的文本查找特定的列。 我需要找到這些列，復制它們並將數據發送到摘要表。

Sub Main()

' Declare hr workbook file
Dim rh As Excel.Workbook

' initialise hr workbook file
Set rh = Workbooks.Open("C:\Users\AC74338\Desktop\ac\rh")

'select the rh file
rh.Select

'select the open worksheet
Sheets("Open").Select

' search for the column header that matches e.g. "Org Level 6"
OrgLevel6 = WorksheetFunction.Match("Org Level 6", Rows("1:1"), 0)
OrgLevel7 = WorksheetFunction.Match("Org Level 7", Rows("1:1"), 0)

'activate this workbook where the code is
ThisWorkbook.Activate

'paste the data that was copied to this workbook in the NxNOpen worksheet
ThisWorkbook.Sheets("NxNOpen").Columns(OrgLevel6).Copy Destination:=Sheets("Sheet2").Range("A1")
ThisWorkbook.Sheets("NxNOpen").Columns(OrgLevel7).Copy Destination:=Sheets("Sheet2").Range("B1")

End Sub

將數據分配給OrgLevel6變量時，我已調試並收到錯誤消息。 有人對如何解決此問題有任何建議嗎？ 對VB不太了解，因此可能是一個簡單的錯誤。

Answer 1

在VBA中使用WorksheetFunction ，您仍然需要使用VBA Range引用，因此，除了使用Rows(1:1)您還需要在VBA代碼中引用行。 例如：

OrgLevel6 = WorksheetFunction.Match("Org Level 6", rh.Sheets("Open").Rows(1), 0)
OrgLevel7 = WorksheetFunction.Match("Org Level 7", rh.Sheets("Open").Rows(1), 0)

Answer 2

將Rows("1:1")更改為Rows(1) 。

您正在名稱為“打開”的工作表上應用匹配功能，但您正在復制工作表“ NxNOpen”中的數據。 右列，錯頁

Answer 3

我已經測試過您的OrgLevel6 =行，並且可以在一張紙上正常工作，因此有可能在沒有激活正確的紙頁的情況下執行它，結果是找不到“ Org Level 6”。

嘗試更改Sheets("Open").Select為Sheets("Open").Activate

Answer 4

請嘗試以下代碼：

Sub Main()

' Declare hr workbook file
Dim rh As Excel.Workbook
Dim sum As Excel.Workbook

Dim b As Integer

' initialise hr workbook file
Set rh = Workbooks.Open("C:\Users\AC74338\Desktop\ac\rh")
Set sum = ThisWorkbook


b = 1

lcol = rh.Sheets("Open").Cells(1, Columns.Count).End(xlToLeft).Column

For i = 1 To lcol

If rh.Sheets("Open").Cells(1, i).Value = "Org Level 6" Or "Org Level 7" Then

rh.Sheets("Open").Columns(i).Copy sum.Sheets("Sheet2").Cells(1, b)
b = b + 1

End If

Next i

End Sub