Batigoal80
Gebruiker
- Lid geworden
- 4 dec 2007
- Berichten
- 52
Ik moet binnen een code een aantal cellen selecteren
Dit is de code:
Sub Wegschrijven_planning()
Dim dFindDate As Date
Dim sFoundShift As String
Dim rngData As Range
Dim lngRow As Long
Dim ws1 As String
Dim ws2 As String
Dim i As Long
wsInvoer = "Invoerblad_planning"
wsdata = "Database"
dFindDate = Sheets(wsInvoer).Range("V1").Value
sFoundShift = Sheets(wsInvoer).Range("W1").Value
Set rngData = Sheets(wsdata).Range("A1:B1", Sheets(wsdata).Range("A1").End(xlDown))
rngData.AutoFilter 1, dFindDate
rngData.AutoFilter 2, sFoundShift
lngRow = rngData.SpecialCells(xlCellTypeVisible).End(xlDown).Row
For i = 1 To 6
Sheets(wsdata).Cells(lngRow, 168 + i) = Sheets(wsInvoer).Cells(1 + i, 22)
Next i
Sheets("Database").Select
Range("A1").Select
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=1
Sheets("Invoerblad_planning").Select
Range("A1:L430").Select
Selection.Interior.ColorIndex = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.ClearContents
Range("V1").Select
Selection.ClearContents
End Sub
In het rode stukje worden de cellen geselecteerd die deze macro moet pakken For i = 1 To 6 .en de cellen waar hij ze moet wegzetten Sheets(wsdata).Cells(lngRow, 168 + i)
Hij neemt nu de cellen C2 tm C7 dit moet worden C1 tm H1
Hij plakt wel goed
Wie weet hoe ik deze positie anders kan bepalen?
Groet Wouter
Dit is de code:
Sub Wegschrijven_planning()
Dim dFindDate As Date
Dim sFoundShift As String
Dim rngData As Range
Dim lngRow As Long
Dim ws1 As String
Dim ws2 As String
Dim i As Long
wsInvoer = "Invoerblad_planning"
wsdata = "Database"
dFindDate = Sheets(wsInvoer).Range("V1").Value
sFoundShift = Sheets(wsInvoer).Range("W1").Value
Set rngData = Sheets(wsdata).Range("A1:B1", Sheets(wsdata).Range("A1").End(xlDown))
rngData.AutoFilter 1, dFindDate
rngData.AutoFilter 2, sFoundShift
lngRow = rngData.SpecialCells(xlCellTypeVisible).End(xlDown).Row
For i = 1 To 6
Sheets(wsdata).Cells(lngRow, 168 + i) = Sheets(wsInvoer).Cells(1 + i, 22)
Next i
Sheets("Database").Select
Range("A1").Select
Selection.AutoFilter Field:=2
Selection.AutoFilter Field:=1
Sheets("Invoerblad_planning").Select
Range("A1:L430").Select
Selection.Interior.ColorIndex = xlNone
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
Selection.Borders(xlEdgeLeft).LineStyle = xlNone
Selection.Borders(xlEdgeTop).LineStyle = xlNone
Selection.Borders(xlEdgeBottom).LineStyle = xlNone
Selection.Borders(xlEdgeRight).LineStyle = xlNone
Selection.Borders(xlInsideVertical).LineStyle = xlNone
Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
Selection.ClearContents
Range("V1").Select
Selection.ClearContents
End Sub
In het rode stukje worden de cellen geselecteerd die deze macro moet pakken For i = 1 To 6 .en de cellen waar hij ze moet wegzetten Sheets(wsdata).Cells(lngRow, 168 + i)
Hij neemt nu de cellen C2 tm C7 dit moet worden C1 tm H1
Hij plakt wel goed
Wie weet hoe ik deze positie anders kan bepalen?
Groet Wouter