Søg
Avatar billede Klaus W Ekspert
18. december 2019 - 21:44 Der er 20 kommentarer og
1 løsning

Fejl i VBA

Hej alle Excel hjælpere.
Jeg bruger nedenstående VBA kode, til at flytte 4 linier, og sætte dem ind i det ark jeg har VBA koden liggende i.

Men jeg for en fejl i linjen rngSourceRange.Copy rngDestination

Kan nogle hjælpen. Oploader lige filerne hvis det kan lette hjælpen.

https://1drv.ms/u/s!AmLaaGiC5LdohuMNbZipXizBzdsLKA?e=NHVUwA

Private Sub CommandButton1_Click()

Dim wkbCrntWorkBook As Workbook
    Dim wkbSourceBook As Workbook
    Dim rngSourceRange As Range
    Dim rngDestination As Range
    Set wkbCrntWorkBook = ActiveWorkbook
    With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
       
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(1)
            Set wkbSourceBook = ActiveWorkbook
            Set rngSourceRange = Application.InputBox(prompt:="Select source range", Title:="Source Range", Default:="b5:e5;b8:e8;b11:e11;b14:e14", Type:=8)
            wkbCrntWorkBook.Activate
            Set rngDestination = Application.InputBox(prompt:="Select destination cell", Title:="Select Destination", Default:="b4:e4;b7:e7;b10:e10;b13:e13", Type:=8)
            rngSourceRange.Copy rngDestination
            rngDestination.CurrentRegion.EntireColumn.AutoFit
            wkbSourceBook.Close False
        End If
    End With

End Sub
Avatar billede store-morten Ekspert
19. december 2019 - 05:30 #1
Mangler der ikke noget?

rngSourceRange.Copy Destination:=rngDestination

Ikke testet.
Avatar billede Klaus W Ekspert
19. december 2019 - 08:51 #2
Godmorgen Morten
Det kan jeg ikke få til at fungere.
Den mærkere godt nok cellerne i kilde filen, og mærkere også cellerne i destinationsfilen.

Men så kommer den op med denne fejl meddelse.
Fejl 1004 Denne handling fungere ikke på flere mærkeringer .-(

KW
Avatar billede store-morten Ekspert
19. december 2019 - 08:58 #3
Det kan man åbenbart ikke på flere områder.

Prøv med et område: b5:e5
Avatar billede Klaus W Ekspert
19. december 2019 - 14:14 #4
Hej Morten

Jeg kan på den gamle måde, men så flytter den hele arket over, også forsvinder formler osv fra destinationsfilen.

KW
Avatar billede Klaus W Ekspert
19. december 2019 - 14:40 #5
Er der nogle der i samme tråd kan hjælpe med at indsætte hvor Excel skal finde filnavn og sti. A la denne kode som er til at gemme excel filen.

Og endvidere kan gå til det bestemte ark i filen.

KW

Dim Path As String
    Dim FileName As String
    Const FilType As String = ".xlsm" ' file type sat som en konstant
   
    If Range("G3") = "" Then ' tester om sti er angivet på arket
        MsgBox "Ingen sti i G3"
        Exit Sub ' afslutter sub'en pga. ingen sti
    End If
    Path = Range("G3")
    If Right(Path, 1) <> "\" Then Path = Path & "\" ' tester om \ stå til sidst ellers sættes den
    FileName = Range("B2")
        ActiveWorkbook.SaveAs FileName:=Path & FileName & FilType, FileFormat _
            :=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
Avatar billede store-morten Ekspert
19. december 2019 - 14:51 #6
Virkede det med et område?

Jeg kan ikke huske din gamle måde ;-)
Avatar billede Klaus W Ekspert
19. december 2019 - 14:56 #7
Undskyld ja det fungere med at den tager det område som jeg har intastet i VBA koden

De gamle koder ser sådan ud

Set rngSourceRange = Application.InputBox(prompt:="Select source range", Title:="Source Range", Default:="A2:f22", Type:=8)
            wkbCrntWorkBook.Activate
            Set rngDestination = Application.InputBox(prompt:="Select destination cell", Title:="Select Destination", Default:="A1", Type:=8)

Men som jeg skrev så overskriver den koder og alt i destinationsarket
Avatar billede Klaus W Ekspert
19. december 2019 - 14:56 #8
Og det var det jeg gerne ville undgå.
Avatar billede Jan Hansen Ekspert
23. december 2019 - 16:27 #9
tror du skal tage det du får fra inputbox og split til et array og bruge det fra arrayet til at sætte celleRange.

hvis du looper gennem arrayet/arrayerne og sætter cellerne hvorefter du copy og derefter videre i loopet.

Bare løse tanker

den anden

thisworkbook.name mener jeg giver det hele!!
Avatar billede Klaus W Ekspert
23. december 2019 - 17:17 #10
Godaften Jan
Tak skal vi tale sammen efter jul.
God jul til dig min Excel-ven :-)

Hilsen KW
Avatar billede Jan Hansen Ekspert
23. december 2019 - 17:50 #11
Lige over
Avatar billede store-morten Ekspert
01. januar 2020 - 16:58 #12
Godt Nytår.
Prøv:
Private Sub CommandButton1_Click()
  If TypeName(Selection) <> "Range" Then Exit Sub
    Dim i As Long
    Dim vRegions As Variant
    Dim rngRegions() As Excel.Range
    Dim rngSourceRange As Excel.Range
    Dim rngDestination As Excel.Range
    Dim wkbCrntWorkBook As Workbook
    Dim wkbSourceBook As Workbook
    Dim DestWorkbook As String
    Dim DestSheet As String
   
    DestWorkbook = ActiveWorkbook.Name
    DestSheet = ActiveSheet.Name
   
  With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(1)
    Set wkbSourceBook = ActiveWorkbook
        End If
    End With
     
  Set rngSourceRange = Application.InputBox(prompt:="Select source range", _
  Title:="Source Range", Default:="b5:e5;b8:e8;b11:e11;b14:e14", Type:=8)
  rngSourceRange.Select

    vRegions = Split(Selection.Address, ",")
   
    ReDim rngRegions(LBound(vRegions) To UBound(vRegions))
 
  Set rngDestination = Application.InputBox(prompt:="Specify the upper left cell for the paste range:", _
  Title:="Select Destination", Default:="b4", Type:=8)
 
  For i = LBound(vRegions) To UBound(vRegions)
    Set rngRegions(i) = Range(vRegions(i))
    rngRegions(i).Copy _
        Destination:=Workbooks(DestWorkbook).Worksheets(DestSheet).Range("B4") _
        .Offset(rngRegions(i).Row - rngRegions(LBound(rngRegions)).Row, _
              rngRegions(i).Column - rngRegions(LBound(rngRegions)).Column)
  Next i
  wkbSourceBook.Close False
End Sub
Avatar billede Klaus W Ekspert
02. januar 2020 - 14:53 #13
Hej store-morten den er bare i vinkel, en lille ting hvor ændre jeg hvis jeg gerne vil have at den skal gå til arket " Billeder 1.deling"
Men ellers 1000 tak

KW
Avatar billede store-morten Ekspert
02. januar 2020 - 15:09 #14
Pas... Har ikke hentet dine filer.
Avatar billede store-morten Ekspert
02. januar 2020 - 15:14 #15
Ps. Input boksen, hvor du vælger destination kan evt. flyttes op i starten.
Avatar billede Klaus W Ekspert
02. januar 2020 - 20:27 #16
Hej igen Store Morten jeg har siddet og prøvet at få fil navnet på kilden flettet ind på alle mulige måder men den bliver ved med at tage fat i destinations filen. Har du mod på lige at se hvor jeg gør noget galt.

KW
https://1drv.ms/u/s!AmLaaGiC5LdohuMNng23HZ_pF5B0fQ?e=VMItAh
Avatar billede store-morten Ekspert
02. januar 2020 - 20:53 #17
Der ligger 4 filer?
Hvad er det du skal have hjælp til?
Avatar billede Klaus W Ekspert
02. januar 2020 - 21:36 #18
Undskyld
Det er filen Delingsliste DNBR med karakter 2020 der har jeg lavet en knap som skal kunne tage billederne fra Delingsliste 2020 med billeder 31-12-2019 over i. Og den kode du kom frem med fungere, og kan også godt tage billederne med over, men det kræver at jeg står i Arket Billeder 1.deling i filen Delingsliste 2020 med billeder 31-12-2019. Det er det jeg har prøvet at sætte ind i VBA sådan at Excel selv går til Arket Billeder 1.deling i filen i Delingsliste 2020 med billeder 31-12-2019.
KW
PS dummyerne er kun til at eksperentere med så jeg ikke for lavet mere l.... end lagkage
Avatar billede store-morten Ekspert
02. januar 2020 - 22:05 #19
Så når: Delingsliste 2020 med billeder 31-12-2019
åbner skal fanen: Billeder 1.deling, være fremme?

Sheets("Billeder 1.deling").Select

Er det altid: Billeder 1.deling?
Avatar billede store-morten Ekspert
02. januar 2020 - 22:31 #20
Prøv:
Private Sub CommandButton1_Click()
  If TypeName(Selection) <> "Range" Then Exit Sub
    Dim i As Long
    Dim vRegions As Variant
    Dim rngRegions() As Excel.Range
    Dim rngSourceRange As Excel.Range
    Dim rngDestination As Excel.Range
    Dim wkbCrntWorkBook As Workbook
    Dim wkbSourceBook As Workbook
    Dim DestWorkbook As String
    Dim DestSheet As String
    Dim Deling As Integer
   
   
    DestWorkbook = ActiveWorkbook.Name
    DestSheet = ActiveSheet.Name
   
      Set rngDestination = Application.InputBox(prompt:="Specify the upper left cell for the paste range:", _
  Title:="Select Destination", Default:="b4", Type:=8)
   
  With Application.FileDialog(msoFileDialogOpen)
        .Filters.Clear
        .AllowMultiSelect = False
        .Show
        If .SelectedItems.Count > 0 Then
            Workbooks.Open .SelectedItems(1)
    Set wkbSourceBook = ActiveWorkbook
        End If
    End With
   
    Deling = Application.InputBox(prompt:="Select Deling", _
    Title:="Source Deling", Default:="1", Type:=1)
      Sheets("Billeder " & Deling & ".deling").Select

  Set rngSourceRange = Application.InputBox(prompt:="Select source range", _
  Title:="Source Range", Default:="b5:e5;b8:e8;b11:e11;b14:e14", Type:=8)
  rngSourceRange.Select

    vRegions = Split(Selection.Address, ",")
   
    ReDim rngRegions(LBound(vRegions) To UBound(vRegions))
   
  For i = LBound(vRegions) To UBound(vRegions)
    Set rngRegions(i) = Range(vRegions(i))
    rngRegions(i).Copy _
        Destination:=Workbooks(DestWorkbook).Worksheets(DestSheet).Range("B4") _
        .Offset(rngRegions(i).Row - rngRegions(LBound(rngRegions)).Row, _
              rngRegions(i).Column - rngRegions(LBound(rngRegions)).Column)
  Next i
  wkbSourceBook.Close False
End Sub
Avatar billede Klaus W Ekspert
03. januar 2020 - 18:04 #21
Hej Store-Morten
Så er den i vinkel 1000 tak

Nu skal jeg så lige lære hvad de forskellige koder betyder.

Tak endnu en gang for et godt samarbejde.

KW
Avatar billede Ny bruger Nybegynder

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.

Loading billede Opret Preview
Kategori
Excel kurser
Excel kurser for alle niveauer og behov – find det kursus, der passer til dig
Se alle Excel kurser

Flere spørgsmål fra Excel kategorien

Titel Indlæg Oprettet Seneste aktivitet
Fødselsdag og anciennitet liste Af Alni i Excel 5 I går 13:46 I går 22:05
Beregn alder (i år, måneder og dage) på personer født før år 1900. Af Balar Seir i Excel 5 11/11/202509:38 13/11/202522:09
Flere ark (tabeller) samlet under et ark i en tabel Af Peder Lund Nielsen i Excel 12 06/11/202522:17 08/11/202509:44
Afskrivningskurve Af tummes1983 i Excel 5 31/10/202513:28 11/11/202521:37
Finde mindsteværdi som er større end 00:00:00 Af Peder Lund Nielsen i Excel 6 20/10/202511:14 20/10/202518:52
Se alle spørgsmål i kategorien Opret spørgsmål

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Opret Log ind

Du kan også logge ind via nedenstående tjenester

Alle kategorier på Eksperten
Seneste spørgsmål Seneste aktivitet
I går 16:39 Manglende driver til netværksdongle Af trav4u2 i Andet netværk
I går 13:46 Fødselsdag og anciennitet liste Af Alni i Excel
15/1117:01 for lille harddisk Af Marie i PC
15/1115:01 Vejledning til køb af (budget) gaming laptop Af Mont22 i PC
15/1112:57 mit.id Af Jette i Tablet
White papers
Flere white papers »