Makrofråga

[araug]

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

[Monshi]

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.

[Monshi]

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)

[araug]

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

[araug]

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

[araug]

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

[araug]

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

[araug]

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

[araug]

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

[araug]

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

[araug]

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 

[araug]

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.

 

/åsa

[Monshi]

Trevligt att det löste sig och ber om ursäkt för missen vid inklistring. hade ingen bok att testa på...