我尝试创建一个宏，根据标题将列从一个工作簿拖到另一个工作簿中。
源工作簿每天都在变化，因此我无法在该目录中获取硬件源。
我有一个宏可以在一个工作簿中使用但是它在资源上非常重要我想要拆分它们，一个用于数据，一个用于可导出工作表。
我将打开文件夹中最新文件的宏是：
'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
（取自here）。
然后我得到了复制正确数据的代码，但仅在使用一个工作簿时：
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
所以基本上我想要连接这两个？所以一般工作量是：
打开目录中的最新文件（或者如果它更简单，可以先打开，然后只需要以某种方式引用所需的工作表 - 我更喜欢这样）
将数据从列复制到新工作簿
答案 0 :(得分：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
答案 1 :(得分：0)
只需将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
功能
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