VB Data Overførelse

Hej Splokit

På den igen her på en højhellig fredag?

Har rodet lidt med det, og måske fundet en løsning:


Sub CopySheet()

Dato = Sheets("T").Range("M2")

DatoExist = False

For Each c In Worksheets("Dagen").Range("K1:K10000")
    If c = Dato Then DatoExist = True
Next c
'If Not Worksheets("Dagen").Range("K:K").Find(Dato, LookIn:=xlValues) Is Nothing Then
'    DatoExist = True
'End If

If Not DatoExist Then
    LastRow = Worksheets("15").Cells.SpecialCells(xlLastCell).Row
    Sheets("T").Range("C2:O25").Copy Worksheets(Format(Day(Dato), "0")).Range("C" & LastRow + 1)
End If

End Sub


Prøver lige på at finde en bedre dato-søgefunktion. Jeg kunne ikke få den oprindelige ide til at virke (er udkommenteret), men ved ikke hvorfor.

Ok, så løste jeg også lige den uden større sværdslag. Nedenstående er lidt hurtigere end det sidste forslag, da dato-søgningen er hurtigere og kigger på alle celler i K kolonnen.

Problemet med datosøgningen var det sædvanlige med at VBA bruger det fæle engelske tidsformat, hvor måneden vises først :0)


Sub CopySheet()

Dato = Format(Sheets("T").Range("M2"), "mm/dd/yyyy")
DatoExist = False

If Not Worksheets("Dagen").Range("K:K").Find(Dato, LookIn:=xlValues) Is Nothing Then
    DatoExist = True
End If

If Not DatoExist Then
    LastRow = Worksheets("15").Cells.SpecialCells(xlLastCell).Row
    Sheets("T").Range("C2:O25").Copy Worksheets(Format(Day(Dato), "0")).Range("C" & LastRow + 1)
End If

End Sub

Kan man gøre det sådan at den tager tager en værdi eks A2= Maj "Maj" Så Åbnet den og søger i Ark (Hvad Værdien siger i B1=21) Så det kommer til at være C:/test/Maj.xls'Ark"21"'

BTW... Hvorfor ikke også på en højhellig fredag, nu man er på arb.. :D

Jamen den mulighed tænkte jeg jo ikke lige over. Beklager :0)

Jeg er ikke helt klar over hvor du vil hen med det sidste spørgsmål. Hvad er det du vil have til at åbne og søge i C:/test/Maj.xls'Ark21 ? Er det datoen, der skal søges i K kolonnen?

Hvis Jeg Laver 12 Sheets et forhver måned "januar.xls:februar:osv" I hver sheet laver jeg et ark for hver dag i den måned "1:2:3:osv" det skal så lige være to Ark et med total og en suplant.

Hvia man så lavet den så den så på værdien i en celle "A1" hvor man har månedens navn "desember" ville den tage og åbne december.xls Der efter på næste værdi "B1" datoen i dag men kun DD/ så det vil blive 2. det er så Ark"2" den skal smide det ind på

december*

så kunne man have nogle formler i A1 & B1 Med måned og dag. så man ikke selv skal åbne dem med gør det ved et klik på en knap som gør noget andet...

Er vi ovre i noget i den retning her?

Destination = Sheets("T").Range("A2") & ".xls!" &  Day(Sheets("T").Range("B2"))

Jeg er stadigvæk ikke med på hvor vi er hende i forhold til det oprindelige spørgsmål? Så jeg er måske lidt forvirret.

Skal det her erstatte destinationen af hvor data skal kopieres hen?

På Sheet1 det kalder vi data.xls det er der dataen kommer fra... på ark "T;C2;=25"
Det skal over på et andet sheet? det sheet er den måned vi er i F.eks December.xls på ark 2 fordi vi har den 2. i dag. så skal man bare lave de ark man skal bruge og så vil den via data.xls/ark"T;A1:B1" Se hvilken sheet & ark den skal overføre den data til som er på "T;C2:O25" Men kun Hvis "M2" på data.xls/ark"T" Ikke Finden i kolonne K.. det er lidt svært at forklare...

men jah det er det samme med bare lidt dyber. men det set rigtigt ud

"M2" er et id-nr det bliver laver når man printer og når det står i m2 laver den ikke et nyt så man kan printe samme sata ud uden at lave nyt id den skal så også bare gøre det med at overføre den date så den ikke vil komme to gange over på de andre ark.

A1 = =IDAG()/mmmm= December.xls "B1 = =nu()/D" = Ark "2"

Ny tester:

Sub CopySheet()

Dato = Format(Sheets("T").Range("M2"), "mm/dd/yyyy")
DatoExist = False

If Not Worksheets("Dagen").Range("K:K").Find(Dato, LookIn:=xlValues) Is Nothing Then
    DatoExist = True
End If

WBName = Sheets("T").Range("A2")
Workbooks.Open FileName:="C:\Test\" & WBName & ".xls"
Workbooks("Splokit2").Activate


If Not DatoExist Then
    LastRow = Workbooks(WBName).Worksheets("15").Cells.SpecialCells(xlLastCell).Row
    Sheets("T").Range("C2:O25").Copy Workbooks(WBName).Worksheets(Format(Day(Dato), "0")).Range("C" & LastRow + 1)
End If

Workbooks(WBName).Close savechanges:=True

End Sub

Ups - du skal nok lige ændre Splokit2 til navnet på det regneark som du har koden i.

Havde helt misforstået den der M2. Skulle være rettet i det nedenstående (hvis altså ID blot er et tal). Desuden finder den selv aktuel måned og aktuel dag (uafhægigt af hvad der står i regnearket):


Sub CopySheet()

CheckID = Sheets("T").Range("M2")
IDExist = False

If Not Worksheets("Dagen").Range("K:K").Find(CheckID, LookIn:=xlValues) Is Nothing Then
    IDExist = True
End If

If Not IDExist Then
    WBName = Format(Date, "mmmm")
    Workbooks.Open FileName:="C:\Test\" & WBName & ".xls"
    Workbooks("Splokit2").Activate

    LastRow = Workbooks(WBName).Worksheets(Format(Date, "d")).Cells.SpecialCells(xlLastCell).Row
    Sheets("T").Range("C2:O25").Copy Workbooks(WBName).Worksheets(Format(Day(Dato), "0")).Range("C" & LastRow + 1)

    Workbooks(WBName).Close savechanges:=True
End If

End Sub

laver fejl her
If Not Worksheets("Dagen").Range("K:K").Find(Dato, LookIn:=xlValues) Is Nothing Then
den skal så også se på A1 for sheet og B1 for ark som den skal søge i

Nu tror jeg lige jeg fangede den del. Øjeblik - der er ny på trapperne.

Hmm. De skal kigge om værdien i M2 i ark "T" findes i regneark "December" på faneblad 2 (det er indtil videre stadig den 2. december) i kolonne K!!??

Er det korrekt at det kolonne K? Umiddebart virker det mere logisk på mig, hvis det er i kolonne M.

jeg har lavet to filer første december.xls anden maj.xls i hver af dem er det 7 ark
første "Total" 2. "suplant" 3. "1" 4. "2" 5. "3" 6. "4" 7. "5"
Hvis det så står maj i a1 og B1 står der 2 på mit ark "splokit2.xls"
Så skal den søge efter det sheet som a1 angiver på den url C:\test\ når den så finder den skal den søge på det ark som B1 angiver. det søger den i kolonne k om værdien på det andet ark "M2" findet hvis ikke det er der skal den smide det ned under det det nu må være det.

det er fordi når det skal rykket over vil M2 stå i K?

23:18:12 -> Det forstod jeg ikke

23:20:56 -> OK. Den fangede jeg ikke fordi jeg kopierede fra C..O til de samme kolonner som de kommer fra. Der bliver lige lavet om.

Sub CopySheet()

CheckID = Sheets("T").Range("M2")
IDExist = False

WBName = Format(Date, "mmmm")
ShName = Format(Date, "d")
Workbooks.Open FileName:="C:\Test\" & WBName & ".xls"
Workbooks("Splokit2").Activate

If Not Workbooks(WBName).Worksheets(ShName).Range("K:K").Find(CheckID, LookIn:=xlValues) Is Nothing Then
    IDExist = True
End If

If Not IDExist Then
    LastRow = Workbooks(WBName).Worksheets(ShName).Cells.SpecialCells(xlLastCell).Row
    Sheets("T").Range("C2:O25").Copy Workbooks(WBName).Worksheets(ShName).Range("A" & LastRow + 1)
End If

Workbooks(WBName).Close savechanges:=True

End Sub

man kan dele den i to... en som smider det over og en ander som ser efter om M2 er på det ønsket ark i den ønsket kolonne. de skal så bare arbejde sammen så hvis det ikke er det skal den smide det over hvis det er der skal den ikke gøre noget..

Husk lige at i linien

Workbooks("Splokit2").Activate

skal du ændre Splokit2 til navnet på dit regneark - altså det hvor din kode ligger i, og hvor du kopierer FRA.

der laver den en fejl
If Not Workbooks(WBName).Worksheets(ShName).Range("K:K").Find(CheckID, LookIn:=xlValues) Is Nothing Then

Jeg havde lige gjort det mere besværligt end højst nødvendigt.

Sub CopySheet()

CheckID = Sheets("T").Range("M2")
IDExist = False

WBName = Format(Date, "mmmm")
ShName = Format(Date, "d")
Workbooks.Open FileName:="C:\Test\" & WBName & ".xls"
Workbooks("Splokit2").Activate

If Workbooks(WBName).Worksheets(ShName).Range("K:K").Find(CheckID, LookIn:=xlValues) Is Nothing Then
    LastRow = Workbooks(WBName).Worksheets(ShName).Cells.SpecialCells(xlLastCell).Row
    Sheets("T").Range("C2:O25").Copy Workbooks(WBName).Worksheets(ShName).Range("A" & LastRow + 1)
End If

Workbooks(WBName).Close savechanges:=True

End Sub

samme fejl
If Workbooks(WBName).Worksheets(ShName).Range("K:K").Find(CheckID, LookIn:=xlValues) Is Nothing Then

Out of range Run-time error '9':

If Workbooks(WBName).Worksheets(ShName).Range("K:K").Find(CheckID, LookIn:=xlValues) Is Nothing Then

I denne linie undersøges om der i den aktuelle fil (skulle være december lige p.t.) under det aktuelle faneblad (skulle stadig være 2) i kolonne K skulle være et tal der er lige med tallet fra T!M2

fanedladet hedder 2 den stopper ved fane 1

Den her fungerer ganske fint hos mig.

Sub CopySheet()

CheckID = Sheets("T").Range("M2")
IDExist = False

WBName = Format(Date, "mmmm")
WSName = Format(Date, "d")
Workbooks.Open FileName:="C:\Test\" & WBName & ".xls"
Workbooks("Splokit2").Activate

If Workbooks(WBName).Worksheets(WSName).Range("K:K").Find(CheckID, LookIn:=xlValues) Is Nothing Then
    LastRow = Workbooks(WBName).Worksheets(WSName).Cells.SpecialCells(xlLastCell).Row
    Sheets("T").Range("C2:O25").Copy Workbooks(WBName).Worksheets(WSName).Range("A" & LastRow + 1)
End If

Workbooks(WBName).Close savechanges:=True

End Sub

Hvis det stadig ikke virker så prøv at kontroller navnene med denne her:

Sub CopySheet()

CheckID = Sheets("T").Range("M2")
IDExist = False

WBNAME = Format(Date, "mmmm")
WSNAME = Format(Date, "d")
Workbooks.Open FileName:="C:\Test\" & WBNAME & ".xls"
Workbooks("Splokit2").Activate

MsgBox "WB = " & WBNAME & vbCrLf & "WS = " & WSNAME, vbOKOnly, "Test"

If Workbooks(WBNAME).Worksheets(WSNAME).Range("K:K").Find(CheckID, LookIn:=xlValues) Is Nothing Then
    LastRow = Workbooks(WBNAME).Worksheets(WSNAME).Cells.SpecialCells(xlLastCell).Row
    Sheets("T").Range("C2:O25").Copy Workbooks(WBNAME).Worksheets(WSNAME).Range("A" & LastRow + 1)
End If

Workbooks(WBNAME).Close savechanges:=True

End Sub



Der skulle komme en box op, hvor der står

WB = december
WS = 2

humm jeg køre med office xp kan det være det for eller en fonktion jeg ikke har kørende

Er du sikker på at navnene er korrekte?

Nå koden kører så langt, så må regnearkets navn (WBNAME) være korrekt.

Hvad med fanebladene? Det hedder vel ikke "2 " eller " 2"?

nu kommer den box med WB = december WS = 2 (OK) når man trykker ok laver den out of range

Sub CopySheet()

CheckID = Sheets("T").Range("M2")
IDExist = False

WBNAME = Format(Date, "mmmm")
WSNAME = Format(Date, "d")
Workbooks.Open Filename:="C:\Test\" & WBNAME & ".xls"
Workbooks("Splokit.xls").Activate

Mit gæt er at "out of range" gælder selve fanebladet - dvs. den kan ikke finde et faneblad med navnet "2"

Jeg beklager, men hos mig hedder filen "Splokit.xls", så derfor går den igen hele tiden.
du skal ændre denne sætning

Workbooks("Splokit.xls").Activate

så det ikke står "Splokit.xls" men navnet på det ark som du bruger!

http://www.splokit.com/test/Splokit.xls
http://www.splokit.com/test/December.xls

De fungerer uden problemer her! Dvs. jeg får ingen fejlmeddelelser. Jeg var også lige inde og slette 11111 i december filen og så blev data kopieret over uden problemer.

jeg skal lige genstarte tror jeg ved hvad problemet er... :S hader netværk...

;0)

Hvis den ikke hedder Workbooks("Splokit.xls").Activate
laver den fejl der

Hvis den Workbooks("Splokit.xls").Activate
laver den fejl her
If Workbooks(WBNAME).Worksheets(WSNAME).Range("K:K").Find(CheckID, LookIn:=xlValues) Is Nothing Then

Hvis kalder dit regneark for f.eks. Data.xls, så kan du ændre

Workbooks("Splokit.xls").Activate

til

Workbooks("Data.xls).Activate

samme fejl... ogsp på en anden computer.. kan det vere en tint som skal køre !? i vb

Prøv lige den her

MsgBox "Check = " & Workbooks(WBNAME).Worksheets(WSNAME).Range("K12"), vbOKOnly, "Test"

Hvis den virker, så er vi det rigtige sted og har adgang til det.


Prøv evt. at checke din hjælpe-funktion vedr. "Find" og se om syntaxen er anderledes.

Nåh ja, msgboxen skal skrive

Check = 11111

som er den værdi du har skrevet i K12 under faneblad 2.

den virker ikke åbner for december og så dør den på.
MsgBox "Check = " & Workbooks(WBNAME).Worksheets(WSNAME).Range("K12"), vbOKOnly, "Test"

Og så virker den jo nok ikke for nu er vo jo over midnat. Prøv at skrive noget i samme celle (K12) under faneblad 3 (stadig i december.xls)

Ok så det er selve adresseringen som den ikke kan lide. Prøv lige

MsgBox "Check = " & Workbooks(WBNAME).Sheets(WSNAME).Range("K12"), vbOKOnly, "Test"

Jeg går ind og lægger mig nu, men kigger forbi igen i morgen

God arbejdslyst  :0)

Takker og sov godt

Sjap du skal have nogle points for din tid du har brugt på denne kode...
Så kom med et svar...

Jamen, det gør jeg gerne.

Jeg prøver stadig at følge lidt med, men er nødt til at holde lidt igen, da jeg læser til eksamen. Nej ikke min egen eksamen - jeg skal eksaminere nogen stakkels studerende. Men ellers skulle jeg være tilbage på fuld styrke i næste uge, eller når rapportlæsningen bliver for trættende :0)

:) Det ser jeg da frem til... Skal da nog finde på nogle skumle koder...  :P

;0)