Just nu i M3-nätverket
Gå till innehåll
araug

LÖST Makrofråga

Rekommendera Poster

Hej

 

Jag behöver hjälp med att redigera ett makro.

 

Makrots funktion är att sammanställa flera flikar till en totalflik. De enskilda flikarnas innehåll kan ändras från gång till gång därför raderas först innehållet i totalfliken varje gång makrot körs.

 

Problemet kommer när celler är tomma i kolumn A i flikarna som kopieras. Det verkar som att makrot tittar efter första tomma cellen i kolumn A (i totalfliken) och där klistrar in nästa fliks innehåll. Så om det inte är något skrivet i kolumn A i de kopierade flikarna börjar inklistringen där och skriver då över det som står i kolumn B, C, D osv. på den raden.

 

Jag vill att makrot tittar i kolumn F för att hitta första tomma cellen/raden och sen klistrar in på den raden med start i kolumn A. 

 

Såhär ser makrot ut:

Sub Combine()

    Dim J As Integer

    Dim Counter As Integer
    Dim LastRow As Integer

    On Error Resume Next

    Sheets(1).Activate
    Rows("2:10000").Delete

    ' work through sheets
    For J = 3 To Sheets.Count ' from sheet 2 to last sheet
        Sheets(J).Activate ' make the sheet active
        Range("A1").Select
    '    Selection.CurrentRegion.Select ' select all cells in this sheets

        ' select all lines except title
        With ActiveSheet
        LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
        End With
        Selection.Offset(1, 0).Resize(LastRow - 1, 16).Select
        ' copy cells selected in the new sheet on last line
        Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)
    Next
   
    Sheets(1).Activate

   
    With ActiveSheet
        Counter = .Cells(.Rows.Count, "F").End(xlUp).Row
        ActiveSheet.ListObjects("Tabell3").Resize Range("$A$1:$P$" & Counter)
    End With
        Rows("2:2").Select
    Selection.Delete Shift:=xlUp

End Sub

 

 

Tack för hjälpen!

/åsa

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Man bör undvika klipp och klistra på det här sättet. Men om det fungerar som du vill så kan du testa att ändra: 

 

  Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)

till

  Selection.Copy Destination:=Sheets(1).Range("F65536").End(xlUp).End(xlToLeft)(2)

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Men MH, nu har jag städat koden under tiden du skrivit det korta...

 Sub Combine()

    Dim J As Integer
    Dim Counter As Integer
    Dim LastRow As Integer

    On Error Resume Next
    With Sheets(1)
        .Rows("2:10000").Delete
    End With
    ' work through sheets
    For J = 3 To Sheets.Count ' from sheet 2 to last sheet
        With Sheets(J) ' make the sheet active
            ' hitta sista rad, kolumn F
            LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
            ' copy cells selected in the new sheet on last line
            .Range("A1").Offset(1, 0).Resize(LastRow - 1, 16).Copy Destination:=Sheets(1).Range("F65536").End(xlUp)(2)
            
        End With
    Next
    With Sheets1
        Dim l As ListObject
        Counter = .Cells(.Rows.Count, "F").End(xlUp).Row
      
        .ListObjects("Tabell3").Resize Range("$A$1:$P$" & Counter)
    
        .Rows("2:2").Delete Shift:=xlUp
    End With
End Sub

Ett annat sätt att hålla reda på var värden ska hamna är att räkna hur många rader som klistrats in i varje steg, summera dem.

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

minsta motståndets lag...

 

 

Har du testat om sökvarianten alltid fungerar?

LastRow = Cells.Find("*",SearchOrder:=xlByRows,SearchDirection:=xlPrevious).Row

Den ser smart ut men har aldrig sett nackdelarna diskuteras.

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Den där varianten har jag inte testat..

Om inget annat finns på bladet finns alltid

 

Range("A1").SpecialCells(xlLastCell).Row

(på frihand, typ det)

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Man bör undvika klipp och klistra på det här sättet. Men om det fungerar som du vill så kan du testa att ändra: 

 

  Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)

till

  Selection.Copy Destination:=Sheets(1).Range("F65536").End(xlUp).End(xlToLeft)(2)

Hej

 

Tack att du tog dig tid att hjälpa mig.

 

Tyvärr fungerade inte denna lösning. Första 32 raderna kom rätt men sen blev det galet. Den började klistra in i kolumn E.

 

/åsa

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Men MH, nu har jag städat koden under tiden du skrivit det korta...

 Sub Combine()

    Dim J As Integer
    Dim Counter As Integer
    Dim LastRow As Integer

    On Error Resume Next
    With Sheets(1)
        .Rows("2:10000").Delete
    End With
    ' work through sheets
    For J = 3 To Sheets.Count ' from sheet 2 to last sheet
        With Sheets(J) ' make the sheet active
            ' hitta sista rad, kolumn F
            LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
            ' copy cells selected in the new sheet on last line
            .Range("A1").Offset(1, 0).Resize(LastRow - 1, 16).Copy Destination:=Sheets(1).Range("F65536").End(xlUp)(2)
            
        End With
    Next
    With Sheets1
        Dim l As ListObject
        Counter = .Cells(.Rows.Count, "F").End(xlUp).Row
      
        .ListObjects("Tabell3").Resize Range("$A$1:$P$" & Counter)
    
        .Rows("2:2").Delete Shift:=xlUp
    End With
End Sub

Ett annat sätt att hålla reda på var värden ska hamna är att räkna hur många rader som klistrats in i varje steg, summera dem.

 

Hej

 

Tack för din tid.

 

Den här fungerar inte heller tyvärr. Den klistrar in från kolumn F (och lämnar rad 2 tom). 

 

/åsa

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Den där varianten har jag inte testat..

Om inget annat finns på bladet finns alltid

 

Range("A1").SpecialCells(xlLastCell).Row

(på frihand, typ det)

 

Hej igen

 

Var i koden ska jag lägga in denna rad?

 

/åsa

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

minsta motståndets lag...

 

 

Har du testat om sökvarianten alltid fungerar?

LastRow = Cells.Find("*",SearchOrder:=xlByRows,SearchDirection:=xlPrevious).Row

Den ser smart ut men har aldrig sett nackdelarna diskuteras.

 

Hej igen 

 

Denna verkar fungera!!!

 

Tack!

 

Ska testa mer noga men vid ett första försök verkar det funka.

 

/åsa

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Rör inte ihop de olika "lastRow" bara. Om du använder klipp och klistra kanske du skall skapa en ny variabel i stil med:

Dim lastRowTarget
lastRowTarget = Sheets(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Selection.Copy Destination:=Sheets(1).Range("A1").Offset(lastRowTarget, 0)

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Rör inte ihop de olika "lastRow" bara. Om du använder klipp och klistra kanske du skall skapa en ny variabel i stil med:

Dim lastRowTarget

lastRowTarget = Sheets(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

Selection.Copy Destination:=Sheets(1).Range("A1").Offset(lastRowTarget, 0)

 

Jag ersatte LastRow i original koden med ditt förslag. Menar du att jag bör lägga in ovan förslag istället? Ersätter jag isåfall bara den raden med ovan kod?

 

Tack för hjälpen.

 

/åsa

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Jag ser nu att det blir inte riktigt rätt med den första lösningen som jag trodde fungerade. Den tar med två tomma rader från en flik. Ska se om jag kan använda din andra lösning.

 

/åsa

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Den LastRow som står i dinoriginalkod används för att markera det som skall klippas ut och den skall du nog inte röra.

 

Jag skrev min lilla snutt som kommentar till Monshis kod.

 

Vill du ändra i din originalkod? Då kan du ersätta

Selection.Copy Destination:=Sheets(1).Range("A65536").End(xlUp)(2)

 

med

 

Dim lastRowTarget
lastRowTarget = Sheets(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Selection.Copy Destination:=Sheets(1).Range("A1").Offset(lastRowTarget, 0)

 

Men klipp och klistra brukar bli struligt så du kanske skall satsa på Monshis kod? Den är ju lite mer genomtänkt/städad och borde funka. 

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Hej

 

Monshis kod fungerar inte tyvärr. Den klistrar in från kolumn F.

 

Ditt senaste förslag fungerar nästan. Dock kommer inte första raden med från första fliken som kopieras. Kan det ha något med rubrikraden i totalfliken att göra? 

 

/åsa

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

i Monsihs kod kan du ändra

.Range("A1").Offset(1, 0).Resize(LastRow - 1, 16).Copy Destination:=Sheets(1).Range("F65536").End(xlUp)(2)
till

 

Dim lastRowTarget
lastRowTarget = Sheets(1).Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
.Range("A1").Offset(1, 0).Resize(LastRow - 1, 16).Copy Destination:=Sheets(1).Range("A1").Offset(lastRowTarget, 0)

 

och kolla koden så att det står Sheets(1) och inte  Sheets1 någonstans

 

När det gäller första raden så skall den inte komma med enligt originalkoden. Den är skapt sådan 

"select all lines except title" som det står i kod-kommentaren

Vill du ha med första raden i originalkoden måste du byta ut:

  Selection.Offset(1, 0).Resize(LastRow - 1, 16).Select

mot

 Selection.Resize(LastRow, 16).Select

 

men då får du nog med en rubrikrad från varje blad. År det meningen?

Kan vara bättre att låta koden vara och efter

 ' work through sheets

kopiera in rubrikraden separat 

  Sheets(1).Rows(1).Value = Sheets(3).Rows(1).Value

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

OK, jag ska testa att ändra Monshis kod enligt ditt förslag.

 

Jag var otydlig i mitt förra inlägg. Vad jag menar är att första raden EFTER rubrikraden alltså rad 2 inte kommer med från första kopierade fliken. Men från efterföljande flikar blir det rätt.

 

/åsa 

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Hej 

 

Tack för all din hjälp! 

 

Jag ändrade Monshis kod enligt ditt förslag ovan sen la jag också in Sheets(1).Activate på slutet för att hamna på totalfliken.

 

Det ser ut att fungera. Jag kommer att testa några omgångar till men än så länge ser det bra ut.

 

Tack ännu en gång för att du lade tid på att hjälpa mig, jag uppskattar det verkligen.

:thumbsup:

 

/åsa

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Kanon. Då var det ju Monshis rensade kod som gjorde susen.

 

En rolig sak är att jag fick nytta av era koder idag! Fick en massa excelblad med data utspritt på flikar som behöver sammanställas. Då slapp man uppfinna hjulet på nytt.

Dela detta inlägg


Länk till inlägg
Dela på andra webbplatser

Skapa ett konto eller logga in för att kommentera

Du måste vara medlem för att kunna kommentera

Skapa ett konto

Skapa ett nytt konto på vårt forum. Det är lätt!

Registrera ett nytt konto

Logga in

Redan medlem? Logga in här.

Logga in nu



×
×
  • Skapa nytt...