计划:循环浏览日期行，复制具有相应标题的列中的非空格

Question

我们的想法是制作一个基于"数据库"：

• 一行包含日期，列中包含所需的传输
• 想在今天搜索并将该列中的非空格复制到另一张纸上"；仪表板">
• 想要复制"标题"的第一列中的相应标题；数据库"；到仪表板

无法让它工作，四处搜索，只是没有得到它，对不起。这方面的新手。。。2个问题：

• 如何解决错误91
• 如何使用autofilter在一行中动态选择正确的日期(基于循环范围(，以将该列中的数据(非空白(复制到另一张工作表

这是代码和它被卡住的地方。如果你想要这个文件，请告诉我。

Sub Transportplan()
'
' Transportplan Macro
'
' Sneltoets: Ctrl+Shift+T

'ZET ALLES KLAAR VOOR NIEUWE PLANNING
'Ga naar planningsoverzicht en delete vorige planning
Sheets("NIEUW").Select
Columns("B:G").Select
Application.CutCopyMode = False
Application.CutCopyMode = False
Selection.ClearContents
With Selection.Interior
.Pattern = xlNone
.TintAndShade = 0
.PatternTintAndShade = 0
End With

'Ga naar data tab
Sheets("DATA").Select
'Alle filters uitdoen
ActiveSheet.ShowAllData
'Activate search criteria in column
ActiveSheet.Range("$A$4:$JN$196").AutoFilter Field:=5, Criteria1:=Array( _
"Transport", "Transport INGEPAKT: Fase + (PALLETnrs)", _
"Transport NIET ingepakt: Fase" & Chr(10) & "!!! RISICO NIET GELEVERD !!!", "Transport Retour" _
), Operator:=xlFilterValues

'--------------------------------------------------------
'START LOOP COPY PASTE SEQUENCE VOOR NIEUWE PLANNING

'1. Choose the date in the tab "Datums voor macro"
Sheets("Datums voor macro").Select
'Loop through dates
Dim rng As Range
Dim cell As Range
Set rng = Range("B4:B31")
For Each cell In rng

'------------------
'Search the date in the DATA tab
Sheets("DATA").Select
Cells.Find(What:="cell", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

'HOW CAN I GET FIELD 21 dynamically changed if the date changes (in row 4)

'If nothing that day, paste just the date
ActiveSheet.Range("$A$4:$JN$1000").AutoFilter Field:=21, Criteria1:="<>"
If (comboBox1.SelectedIndex = -1) Then
'Go to planning and paste that day
Sheets("NIEUW").Select
Range("G1").Select
ActiveCell.End(xlDown).Offset(1, 0).Select
ActiveRange = cell.Value

Else
'HOW CAN I GET FIELD 21 dynamically changed if the date changes (in row 4). I activated the macro through record and pressing Ctrl+F and pasting the date...
ActiveSheet.Range("$A$4:$JN$196").AutoFilter Field:=21, Criteria1:="<>"
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Copy
'Go to planning and paste data
Sheets("NIEUW").Select
Range("G1").Select
ActiveCell.End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste

'Copy headers from DATA tab
Sheets("DATA").Select
Range("E4").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Range(Selection, Selection.End(xlToLeft)).Select
Application.CutCopyMode = False
Selection.Copy
'PASTE HEADERS in planning
Sheets("NIEUW").Select
'Search next empty cel to paste under previous data
Range("B1").Select
ActiveCell.End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste

End If

'END LOOP 1
'-----------------------------------

'RESTART LOOP
Next cell
End Sub

Answer 1

如果未找到匹配项，则THis将给出运行时错误：

datadag.Find(What:="cell", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False).Activate

请使用以下模式：

Dim f As Range
Set f = datadag.Find(What:="cell", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not f Is Nothing Then
'do something with f
Else
'handle "not found" case
End if