09. maj 2009 - 01:02Der er
1 kommentar og 1 løsning
Kopiere værdier fra valgte celler i ark 1 til 12 ud fra værdi i celle på værdi ark
Hejsa eksperter!
Nu har jeg læst og klippet og klistret i 5 uger, og det vil bare ikke lykkes.
Det jeg gerne vil have hjælp til er en makro. Jeg bruger Excel 2007 på en maskine med vista.
Regnearket er på 36 ark Ark 1 til 12 er navngivet "Jan, Feb, Mar" osv. "kun 3 bogstaver" Ark 36 er navngivet "Værdi"
Ark 36: værdi Kolonne B række 2 står dags dato Kolonne B række 4 står datoen 1-1-09 Kolonne B række 5 til 369 er formelbaseret således at datoerne kun fremkommer når dags dato oprunder.
Ark 1 til 12: Jan, Feb, Mar osv. Kolonne B række 4 dato for første dag i md., efterfølgende datoer for md. står nedefter i kolonne B. Slut rækken variere da md. ikke er lige lange, Jan er række 34, Feb 31, Mar 34, Apr 33 osv.
Makroen skal tage værdi/dato "søgekriteria" i kolonne B på ark 36 "værdi arket" søge efter tilsvarende værdi/dato i kolonne B på ark 1 til 12, når den finder en match skal den kopiere værdierne fra cellerne "G, I, K, N, Q, T, W, Z" i samme række som match er fundet "også tomme celler" og paste til kolonne C, D, E i samme række på "værdi arket" som søgekriteria er taget fra altså G til C, I til D, K til E osv. det skal kun være værdierne og ikke formlerne der skal kopieres, format og celle brede skal være det samme. Næste celle i kolonne B på "værdi arket" køre søgning og kopiering igen
Når der ikke er flere datoer i kolonne B på "værdi arket" skal makroen stoppe.
Makroen skal starte forfra hvergang den køres.
hvis jeg ikke har gjort mig forstålig nok så spørg.
I dette særtema ser vi på, hvordan cloud og AI bliver fundamentet for virksomhedernes digitale forretning, og hvordan de nye muligheder for automatisering og forretningsværdi kan udnyttes uden at miste overblik, sikkerhed og menneskelig kontrol.
Set I = Sheets Dim LDate As Variant Dim LColumn As Integer Dim LFound As Boolean Dim n Dim j
n = 4
Application.ScreenUpdating = False
For d = 1 To 12 'Arbejder sig igennem Ark 1 til 12
j = 4 r = 4
Sheets(d).Activate 'Aktivere Arket
While Cells(r, 2) > 0 'Finder sidste celle i kolonne B med værdi r = r + 1 Wend Cells(r - 1, 2).Select Range(ActiveCell, ActiveCell.End(xlUp)).Select 'Markere celler i kolonne B med værdi
For Each Cell In Selection 'For hver celle i markering
LDate = Sheets("Værdi").Range("B" & n).Value 'Henter dato værdi der skal søges efter
Cells(j, "G").Select
Sheets(d).Select
LColumn = 2 'Vælger kolonne B LFound = False
While LFound = False
If Len(Cells(j, LColumn)) = 0 Then 'Når ingen matgh er fundet stoppes makroen Cells(j, "G").Select Exit Sub
ElseIf Cells(j, LColumn) = LDate Then 'Fundet match i række Sheets(d).Select 'Vælger værdier til kopiering fra "Måneds" Ark Range("G" & j & ":AB" & j).Copy Sheets("Værdi").Select 'Sætter ind på "Værdi" Ark Cells(n, LColumn + 1).Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False LFound = True Else 'Fortsæt Søgning LColumn = LColumn + 1 End If
Jeg kan godt se at der er nogle underlige tegn imellem, så jeg prøver igen
Sub CopyDataToVaerdi()
Set I = Sheets Dim LDate As Variant Dim LColumn As Integer Dim LFound As Boolean Dim n Dim j
n = 4
Application.ScreenUpdating = False
For d = 1 To 12 'Arbejder sig igennem Ark 1 til 12
j = 4 r = 4
Sheets(d).Activate 'Aktivere Arket
While Cells(r, 2) > 0 'Finder sidste celle i kolonne B med værdi r = r + 1 Wend Cells(r - 1, 2).Select Range(ActiveCell, ActiveCell.End(xlUp)).Select 'Markere celler i kolonne B med værdi
For Each Cell In Selection 'For hver celle i markering
LDate = Sheets("Værdi").Range("B" & n).Value 'Henter dato værdi der skal søges efter
Cells(j, "G").Select
Sheets(d).Select
LColumn = 2 'Vælger kolonne B LFound = False
While LFound = False
If Len(Cells(j, LColumn)) = 0 Then 'Når ingen matgh er fundet stoppes makroen Cells(j, "G").Select Exit Sub
ElseIf Cells(j, LColumn) = LDate Then 'Fundet match i række Sheets(d).Select 'Vælger værdier til kopiering fra "Måneds" Ark Range("G" & j & ":AB" & j).Copy Sheets("Værdi").Select 'Sætter ind på "Værdi" Ark Cells(n, LColumn + 1).Select Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _ xlNone, SkipBlanks:=False, Transpose:=False Selection.PasteSpecial Paste:=xlPasteColumnWidths, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False Application.CutCopyMode = False LFound = True Else 'Fortsæt Søgning LColumn = LColumn + 1 End If
Wend
n = n + 1 j = j + 1 Next Next d
Exit Sub
Application.ScreenUpdating = True
End Sub
Det ser bedre ud
Synes godt om
Ny brugerNybegynder
Din løsning...
Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links. Der sættes "nofollow" på alle links.
