我搜索了很多类似的主题并得到了一些帮助，但我找不到办法去做我需要的东西（可能是因为我对excel和vba的经验有限），所以在这里：
我有一个（来源）工作表'offer'，每天填充一次，其中包含以下列：
columns: b c d e f g
header: offercode issue dt worktype customer sent dt confirmation dt
xxx.xx. 1/1/14 MI john 1/1/14 3/1/14
aaa.aa. 1/1/14 MD bob 2/1/14
bbb.bb 2/1/14 SI peter 2/1/14 3/1/14
我需要的是复制在另一张“生产订单”（目的地）中获得确认日期（非空白）的所有行 我生成生产订单代码并输入其他类型的数据：
columns: b c d e f g
header: offercode productioncode worktype start end confirmation dt
xxx.xx. 1/1/14 MI 5/1/14 3/1/14
bbb.bb 2/1/14 SI 6/1/14 3/1/14
请注意列b和b＆amp; c包含公式（生成要约代码）
我的问题是每天都会填充数据，并且要约（来源表）应按发布日期排序，一旦确认（输入确认日期 - >非空白），它们应该复制到另一张表中但已排序（或者通过确认日期来确定下一个空行：例如：
columns: b c d e f g
header: offercode productioncode worktype start end confirmation dt
xxx.xx. XX.XXX. MI 5/1/14 3/1/14
bbb.bb BB.BBB SI 6/1/14 3/1/14
aaa.aa. AA>AAA MD 4/1/14
另一个问题是第二个（目标表）列表用新数据刷新的频率或时间，我的猜测是在每个数据输入实例工作后点击一个控制按钮（并确保列表是最新的）
提前谢谢你，
安耶洛斯
答案 0 :(得分：0)
所以，这就是我现在正在使用的，它全部基于@ simoco的代码： 我正在检查操作一致性，但代码工作正常。
它只复制和粘贴我需要它的（我）感兴趣的列，然后对动态范围进行排序。
Sub copycolumnsonly()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim lastrow1 As Long
Dim lastrow2 As Long
Dim j As Long
Dim i As Long
Dim rng As Range
'set correct name of the sheet with your data'
Set sh1 = ThisWorkbook.Worksheets("ÐÑÏÓÖÏÑÅÓ")
'set correct name of the sheet where you need to paste data'
Set sh2 = ThisWorkbook.Worksheets("ÅÍÔÏËÅÓ ÐÁÑÁÃÙÃÇÓ")
'determining last row of your data in file ÁÁÁÁÁÁÁÁ.xlsx'
lastrow1 = sh1.Range("C" & sh1.Rows.Count).End(xlUp).Row
'determining last row of your data in file ÂÂÂÂÂÂÂÂ.xls'
lastrow2 = sh2.Range("F" & sh2.Rows.Count).End(xlUp).Row
'clear content in sheet2
sh2.Range("F11:F" & lastrow2).ClearContents
sh2.Range("G11:G" & lastrow2).ClearContents
sh2.Range("N11:N" & lastrow2).ClearContents
'suppose that in sheet2 data starts from row #11
j = 11
For i = 0 To lastrow1
Set rng = sh1.Range("G11").Offset(i, 0)
'check whether value in column D is not empy
If Not (IsNull(rng) Or IsEmpty(rng)) Then
sh1.Range("B" & i + 11).Copy
sh2.Range("F" & j).PasteSpecial xlPasteValues
sh1.Range("g" & i + 11).Copy
sh2.Range("G" & j).PasteSpecial xlPasteValues
sh1.Range("K" & i + 11).Copy
sh2.Range("N" & j).PasteSpecial xlPasteValues
j = j + 1
End If
Next i
Application.CutCopyMode = False
'sorting the new list, recorded macro tweaked to use a dynamic named range
ActiveWorkbook.Worksheets("ÅÍÔÏËÅÓ ÐÁÑÁÃÙÃÇÓ").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ÅÍÔÏËÅÓ ÐÁÑÁÃÙÃÇÓ").Sort.SortFields.Add Key:=Range( _
"G:G"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("ÅÍÔÏËÅÓ ÐÁÑÁÃÙÃÇÓ").Sort
.SetRange Range("PRODUCTIONORDERS")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub
答案 1 :(得分：0)
这是我提出的完全不同的方法，
如果您可以检查错误处理或用户输入无效等，我将不胜感激 （见代码中的评论） `
Sub ActiveToLastRow()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
Dim activerow As Long
Dim lastrow2 As Long
Dim rng As Range
Dim confirmation As Range
'set correct name of the sheet with your data
Set sh1 = ThisWorkbook.Worksheets("ÐÑÏÓÖÏÑÅÓ")
'set correct name of the sheet where you need to paste data
Set sh2 = ThisWorkbook.Worksheets("ÅÍÔÏËÅÓ ÐÁÑÁÃÙÃÇÓ")
'making sure the user selects the correct offercode via inputbox to get its rownumber --> see activerow variable
Set rng = Application.InputBox("dialeje prosfora", "epilogh prosforas", Type:=8)
'getting the information(confirmation date) via input box form the user
Dim TheString As String
Dim TheDate As Date
TheString = Application.InputBox("Enter A Date", "epibebaiwsh anathesis")
If IsDate(TheString) Then
TheDate = DateValue(TheString)
Else
MsgBox "Invalid date"
'need to end sub if user input is invalid
End If
'determining active row of your data in file ÁÁÁÁÁÁÁÁ.xlsx where data input occurs <-- user input via 1st input box
activerow = rng.Row
Set confirmation = sh1.Range("G" & activerow)
confirmation.Value = TheDate
'determining last row of your data in file ÂÂÂÂÂÂÂÂ.xls'
lastrow2 = sh2.Range("F" & sh2.Rows.Count).End(xlUp).Row
'determining what to copy and where
sh1.Range("B" & activerow).Copy
sh2.Range("F" & lastrow2 + 1).PasteSpecial xlPasteValues
sh1.Range("g" & activerow).Copy
sh2.Range("G" & lastrow2 + 1).PasteSpecial xlPasteValues
sh1.Range("K" & activerow).Copy
sh2.Range("N" & lastrow2 + 1).PasteSpecial xlPasteValues
Application.CutCopyMode = False
'activating destination sheet for testing purposes
sh2.Activate
End Sub`
答案 2 :(得分：0)
看起来您只需要复制那些在＆＃34;确认日期＆＃34;中的值的行。专栏 - 如果我正确阅读上述内容。 如果带有每日更新的工作表被调用＆＃34; First＆＃34;，并且只有确认订单的结果工作表被调用＆＃34; Second＆＃34;，以下应该这样做......
Sub Macro1（） ＆＃39; ＆＃39; Macro1宏 ＆＃39;
＆＃39; lastRow = 10＆＃39;硬编码在这里;使用任何技术来获得真正的价值。
'Copy over the headers to the new sheet
Sheets("First").Select
Rows("1:1").Select
Selection.Copy
Sheets("Second").Select
Range("A1").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Columns("A:F").ColumnWidth = 9
Columns("G:G").ColumnWidth = 12
Sheets("First").Select
' Range("G1").Select
Confirm_Count = 0
For Row = 1 To lastRow
If Len(Range("G1").Offset(Row, 0)) > 1 Then
Rows(Row + 1).Select
Selection.Copy
Sheets("Second").Select
Confirm_Count = Confirm_Count + 1
Range("A1").Offset(Confirm_Count, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Sheets("First").Select
End If
Next Row
End Sub