将特定工作表中的列复制到基于标题的打开的工作表中

我试图创build一个macros，将从一个工作簿到另一个列，根据他们的标题。

源工作簿每天都在改变，所以我不能在这个目录下难以find目录。

我有一个macros可以在一个工作簿中使用，但是资源非常繁重，所以我正在分解它们，一个用于数据，另一个用于可导出工作表。

我有这个macros将打开文件夹中的最新文件是：

'Force the explicit delcaration of variables Option Explicit Sub OpenLatestFile() 'Declare the variables Dim MyPath As String Dim MyFile As String Dim LatestFile As String Dim LatestDate As Date Dim LMD As Date 'Specify the path to the folder MyPath = "C:\Users\Domenic\Documents\" 'Make sure that the path ends in a backslash If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\" 'Get the first Excel file from the folder MyFile = Dir(MyPath & "*.xls", vbNormal) 'If no files were found, exit the sub If Len(MyFile) = 0 Then MsgBox "No files were found...", vbExclamation Exit Sub End If 'Loop through each Excel file in the folder Do While Len(MyFile) > 0 'Assign the date/time of the current file to a variable LMD = FileDateTime(MyPath & MyFile) 'If the date/time of the current file is greater than the latest 'recorded date, assign its filename and date/time to variables If LMD > LatestDate Then LatestFile = MyFile LatestDate = LMD End If 'Get the next Excel file from the folder MyFile = Dir Loop 'Open the latest file Workbooks.Open MyPath & LatestFile End Sub 

（从这里拿）。

然后我得到了复制正确的数据的代码，但只有当使用一个工作簿时：

 Sub EditMoveColumns() ' MoveColumns Macro ' Description: Rearrange columns in Excel based on column header Dim iRow As Long Dim iCol As Long 'Constant values data_sheet1 = "EDIT" 'Define MediaMath tab as the sheet to run macro on target_sheet1 = "Filtered Edit" iRow = Sheets(data_sheet1).UsedRange.Rows.Count 'Determine how many rows are in use Worksheets.Add.Name = "Filtered Edit" 'Start organizing columns For iCol = 1 To Sheets(data_sheet1).UsedRange.Columns.Count 'Sets the TargetCol to zero in order to prevent overwriting existing targetcolumns TargetCol = 0 'Read the header of the original sheet to determine the column order If Sheets(data_sheet1).Cells(7, iCol).Value = "Status" Then TargetCol = 1 If Sheets(data_sheet1).Cells(7, iCol).Value = "Trader" Then TargetCol = 2 If Sheets(data_sheet1).Cells(7, iCol).Value = "IOMT Brief ID" Then TargetCol = 3 If Sheets(data_sheet1).Cells(7, iCol).Value = " Vendor (DSP) " Then TargetCol = 4 If Sheets(data_sheet1).Cells(7, iCol).Value = "DSP Campaign ID" Then TargetCol = 5 If Sheets(data_sheet1).Cells(7, iCol).Value = " Client " Then TargetCol = 6 If Sheets(data_sheet1).Cells(7, iCol).Value = "Campaign" Then TargetCol = 7 If Sheets(data_sheet1).Cells(7, iCol).Value = "Buying type" Then TargetCol = 8 If Sheets(data_sheet1).Cells(7, iCol).Value = "Overall Pacing %" Then TargetCol = 9 If Sheets(data_sheet1).Cells(7, iCol).Value = "Yesterday's DSP Spend" Then TargetCol = 10 If Sheets(data_sheet1).Cells(7, iCol).Value = "Target Daily DSP Spend (Trading Currency)" Then TargetCol = 11 If Sheets(data_sheet1).Cells(7, iCol).Value = "Yesterday's DSP Impressions" Then TargetCol = 12 If Sheets(data_sheet1).Cells(7, iCol).Value = "Target Daily DSP Impressions" Then TargetCol = 13 If Sheets(data_sheet1).Cells(7, iCol).Value = "Spend Variance From Daily Target" Then TargetCol = 14 If Sheets(data_sheet1).Cells(7, iCol).Value = "Impression Variance From Daily Target" Then TargetCol = 15 If Sheets(data_sheet1).Cells(7, iCol).Value = " Country " Then TargetCol = 16 If Sheets(data_sheet1).Cells(7, iCol).Value = "CTR" Then TargetCol = 17 If Sheets(data_sheet1).Cells(7, iCol).Value = "Days Remaining" Then TargetCol = 18 'If a TargetColumn was determined (based upon the header information) then copy the column to the right spot If TargetCol <> 0 Then 'Select the column and copy it Sheets(data_sheet1).Range(Sheets(data_sheet1).Cells(7, iCol), Sheets(data_sheet1).Cells(iRow, iCol)).Copy Sheets(target_sheet1).Cells(1, TargetCol).PasteSpecial xlPasteValues End If Next iCol 'Move to the next column until all columns are read Call Sortalphabetically End Sub 

所以基本上我想要连接这两个？ 所以一般的工作量是：

• 在目录中打开最近的文件（或者，如果它更简单，可以先打开，然后只需简单地引用所需的工作表 – 我宁愿这样）

• 将数据从列复制到新的工作簿

Answer 1

将Sub OpenLatestFile()转换成一个返回最近打开的工作簿的函数：

 Function OpenLatestFile() as Workbook '... ' At the end: Set OpenLatestFile = Workbooks.Open MyPath & LatestFile End Function 

对Sub EditMoveColumns()以下修改

 Sub EditMoveColumns() Dim targetWB As Workbook: Set targetWB = OpenLatestFile ' <-- add this line at beginning ' ... targetWB.Worksheets.Add.Name = "Filtered Edit" '<-- modified ' ... ' Modify the body of the if statement like following If TargetCol <> 0 Then with Sheets(data_sheet1) targetWB.Sheets(target_sheet1).Cells(1, TargetCol).Value = _ .Range(.Cells(7, iCol), .Cells(iRow, iCol)).Value End with End If ' ... End Sub 

Answer 2

只需将OpenLastestFile转换为函数，就可以在其他过程中调用它：

（我已经添加了对象引用， With和更改Copy以提高可读性和性能）

 Sub EditMoveColumns() ' MoveColumns Macro ' Description: Rearrange columns in Excel based on column header Dim wB As Workbook Set wB = OpenLatestFile Dim wSDaTa As Worksheet Dim wSTargeT As Worksheet Dim iRow As Long Dim iCol As Long 'Constant values data_sheet1 = "EDIT" 'Define MediaMath tab as the sheet to run macro on target_sheet1 = "Filtered Edit" Set wSDaTa = wB.Sheets(data_sheet1) Set wSTargeT = wB.Worksheets.Add wSTargeT.Name = target_sheet1 With wSDaTa iRow = .UsedRange.Rows.Count 'Determine how many rows are in use 'Start organizing columns For iCol = 1 To .UsedRange.Columns.Count 'Sets the TargetCol to zero in order to prevent overwriting existing targetcolumns TargetCol = 0 'Read the header of the original sheet to determine the column order With .Cells(7, iCol) If .Value = "Status" Then TargetCol = 1 If .Value = "Trader" Then TargetCol = 2 If .Value = "IOMT Brief ID" Then TargetCol = 3 If .Value = " Vendor (DSP) " Then TargetCol = 4 If .Value = "DSP Campaign ID" Then TargetCol = 5 If .Value = " Client " Then TargetCol = 6 If .Value = "Campaign" Then TargetCol = 7 If .Value = "Buying type" Then TargetCol = 8 If .Value = "Overall Pacing %" Then TargetCol = 9 If .Value = "Yesterday's DSP Spend" Then TargetCol = 10 If .Value = "Target Daily DSP Spend (Trading Currency)" Then TargetCol = 11 If .Value = "Yesterday's DSP Impressions" Then TargetCol = 12 If .Value = "Target Daily DSP Impressions" Then TargetCol = 13 If .Value = "Spend Variance From Daily Target" Then TargetCol = 14 If .Value = "Impression Variance From Daily Target" Then TargetCol = 15 If .Value = " Country " Then TargetCol = 16 If .Value = "CTR" Then TargetCol = 17 If .Value = "Days Remaining" Then TargetCol = 18 End With '.Cells(7, iCol) 'If a TargetColumn was determined (based upon the header information) then copy the column to the right spot If TargetCol <> 0 Then 'Transfer Data directly to the target sheet! wSTargeT.Range(wSTargeT.Cells(1, TargetCol), wSTargeT.Cells(iRow - 6, TargetCol)).Value = _ .Range(.Cells(7, iCol), .Cells(iRow, iCol)).Value End If Next iCol 'Move to the next column until all columns are read End With 'wSDaTa Call Sortalphabetically End Sub 

和function

 Private Function OpenLatestFile() As Workbook 'Declare the variables Dim MyPath As String Dim MyFile As String Dim LatestFile As String Dim LatestDate As Date Dim LMD As Date 'Specify the path to the folder MyPath = "C:\Users\Domenic\Documents\" 'Make sure that the path ends in a backslash If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\" 'Get the first Excel file from the folder MyFile = Dir(MyPath & "*.xls", vbNormal) 'If no files were found, exit the sub If Len(MyFile) = 0 Then MsgBox "No files were found...", vbExclamation Exit Function End If 'Loop through each Excel file in the folder Do While Len(MyFile) > 0 'Assign the date/time of the current file to a variable LMD = FileDateTime(MyPath & MyFile) 'If the date/time of the current file is greater than the latest 'recorded date, assign its filename and date/time to variables If LMD > LatestDate Then LatestFile = MyFile LatestDate = LMD End If 'Get the next Excel file from the folder MyFile = Dir Loop 'Open the latest file Set OpenLatestFile = Workbooks.Open(MyPath & LatestFile) End Function