Trädvy Permalänk
Medlem
Registrerad
Feb 2012

Excel VBA copy/paste

Hej

Försöker kopiera ett par rader med formattering och referenser till andra celler, vill att dom ska insertas just under dom raderna (som ligger högst upp) hidden

Google verkar ha 45miljoner lösningar, får det inte att fungera oavsett.
Får ut kopia av första cellen I varje cell för raden

Sub Template()
Set sh = Sheets("Sheet2")
sh.Range("A3:A6").EntireRow.Copy
sh.Range("A7").EntireRow.Insert xlShiftDown
Application.CutCopyMode = False
End Sub

Trädvy Permalänk
Medlem
Registrerad
Aug 2014
Skrivet av lappen81:

Hej

Försöker kopiera ett par rader med formattering och referenser till andra celler, vill att dom ska insertas just under dom raderna (som ligger högst upp) hidden

Google verkar ha 45miljoner lösningar, får det inte att fungera oavsett. Copy, Insert fungerar men inte Paste

Sub Template()
' Keyboard Shortcut: Ctrl+q
Set tplRows = Sheets("Sheet").Range("A3:A6")
Set dstRows = Sheets("Sheet").Range("A6:A9")
dstRows.EntireRow.Insert
'tplRows.CopyTo.Range(dstRows).Insert
tplRows.Copy
dstRows.Select
dstRows.Paste
Application.CutCopyMode = False
End Sub

1. Du behöver inte 'dstRows.Select' den koden gör inget i denna sub
2. Använd .PasteSpecial istället för .Paste, så kan du välja ut precis vilka delar av cellen du vill klistra in och vilka inte.
3. Dina ranges överlappar vatrandra, vilket gör det hela lite märkligt. Kör igenom min kod med F8 och se bilden som illustrerar. Justera dina ranges så det funkar rätt. Jag antar att det kanske borde vara A2:A6 A7:A10, men jag vet ju inte.
4. Jag rekommenderar att du namnger dina ranges istället för att kalla på cellreferenser .Range("A3:A6") --> .Range("MyDescriptiveSourceRangeName1")

Sub Template()
' Keyboard Shortcut: Ctrl+q
Set tplRows = Sheets("Sheet").Range("A3:A6")
Set dstRows = Sheets("Sheet").Range("A6:A9")
dstRows.EntireRow.Insert
tplRows.Copy
dstRows.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False

End Sub

Z170-WS | Intel 6700K | Dominator 2x16GB 3000MHz | Samsung 950 Pro 2x512GB NVMe RAID0 | MSI 1080 Gaming X | Seasonic 520 Fanless | 7260 HMV-AC | Fractal Design Define R4 | Noctua NH-U12S@475RPM | Noctua P12@475RPM x5
Supermicro X10SLL-F | Supermicro 1U SC813MT-300C | XEON E3 1231v3 | Hynix 4x8GB ECC | 840 EVO | WD 6x 4TB RE
x220 | IPS | i7 | SSD | 9-cell

Trädvy Permalänk
Medlem
Registrerad
Feb 2012
Skrivet av ggwp:

1. Du behöver inte 'dstRows.Select' den koden gör inget i denna sub
2. Använd .PasteSpecial istället för .Paste, så kan du välja ut precis vilka delar av cellen du vill klistra in och vilka inte.
3. Dina ranges överlappar vatrandra, vilket gör det hela lite märkligt. Kör igenom min kod med F8 och se bilden som illustrerar. Justera dina ranges så det funkar rätt. Jag antar att det kanske borde vara A2:A6 A7:A10, men jag vet ju inte.
4. Jag rekommenderar att du namnger dina ranges istället för att kalla på cellreferenser .Range("A3:A6") --> .Range("MyDescriptiveSourceRangeName1")

Sub Template()
' Keyboard Shortcut: Ctrl+q
Set tplRows = Sheets("Sheet").Range("A3:A6")
Set dstRows = Sheets("Sheet").Range("A6:A9")
dstRows.EntireRow.Insert
tplRows.Copy
dstRows.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False

End Sub

shox.se/sheet.jpg

Super löste sig , den kopierar nya som hidden men det bör ju vara ett mindre problem (avdöljas)

Sub Template()
Set tplRows = Sheets("Sheet2").Range("A3:A6")
Set dstRows = Sheets("Sheet2").Range("A7:A10")
tplRows.EntireRow.Copy
dstRows.EntireRow.Insert
End Sub

Trädvy Permalänk
Medlem
Registrerad
Aug 2014
Skrivet av lappen81:

Super löste sig , den kopierar nya som hidden men det bör ju vara ett mindre problem (avdöljas)

Sub Template()
Set tplRows = Sheets("Sheet2").Range("A3:A6")
Set dstRows = Sheets("Sheet2").Range("A7:A10")
tplRows.EntireRow.Copy
dstRows.EntireRow.Insert
End Sub

Toppen.

Avluta med att visa raderna du vill visa, typ: dstRows.EntireRow.Hidden = False . Eftersom detta inte gör något ifall raderna inte skulle vara gömda av någon anledning så skadar det absolut inte ändå.

Ett tips är att du vänjer dig använda With när du har mer än 1 rad kod som referrerar till samma objekt

Generellt:
Sub Template()
Set tplRows = Sheets("Sheet2").Range("A3:A6")
Set dstRows = Sheets("Sheet2").Range("A7:A10")
tplRows.EntireRow.Copy
With dstRows.EntireRow
.Insert
.Hidden = False
End With
End Sub

Eller i detta fall om du aldrig refererar till själva rangen ändå:
Sub Template()
Set tplRows = Sheets("Sheet2").Range("A3:A6").EntireRow
Set dstRows = Sheets("Sheet2").Range("A7:A10").EntireRow
tplRows.Copy
With dstRows
.Insert
.Hidden = False
End With
End Sub

Det kanske verkar lite löjligt nu. Men vänj dig skriva konsekvent på detta sätt då det gör stor skillnad vid lite tyngre beräkningar eftersom detta sätt att skriva vba minimerar antalet anrop till objekten som i sin tur minskar körtiden.

Z170-WS | Intel 6700K | Dominator 2x16GB 3000MHz | Samsung 950 Pro 2x512GB NVMe RAID0 | MSI 1080 Gaming X | Seasonic 520 Fanless | 7260 HMV-AC | Fractal Design Define R4 | Noctua NH-U12S@475RPM | Noctua P12@475RPM x5
Supermicro X10SLL-F | Supermicro 1U SC813MT-300C | XEON E3 1231v3 | Hynix 4x8GB ECC | 840 EVO | WD 6x 4TB RE
x220 | IPS | i7 | SSD | 9-cell

Trädvy Permalänk
Medlem
Registrerad
Feb 2012

@ggwp: Tack för tipset

Fungerar inte med
dstRows.Hidden = False eller With dstRows .Hidden = False första kopieringen blir hidden andra fungerar. Kör jag ett separate anrop I slutet av koden fungerar det även vid första kopieringen

vh

Sub Template()
' Keyboard Shortcut: Ctrl+q
Set tplRows = Sheets("TimeReport").Range("3:6")
Set dstRows = Sheets("TimeReport").Range("7:10")
tplRows.EntireRow.Copy

With dstRows
.EntireRow.Insert
'.EntireRow.Hidden = False
End With
Sheets("TimeReport").Range("7:10").EntireRow.Hidden = False
End Sub

Trädvy Permalänk
Medlem
Registrerad
Aug 2014

Det är för att dstRows referensten flyttar sig när du kör insert. Justera med .Offset

With dstRows
.EntireRow.Insert
.Offset(tplRows.rows,0).EntireRow.Hidden = False
End With

Det är pga attribut som .Hidden som kopieras med .Copy som vi föredrar att använda .PasteSpecial över .Paste och .Insert. På det sättet plockar man ut exakt vad man vill kopiera över. I detta fall kanske Paste:=xlPasteValuesAndNumberFormats eller Paste:=xlPasteFormulasAndNumberFormats vilket betyder att det gömda attributet inte följer med i kopieringen, utan följer destinationscellens attribut istället.

Z170-WS | Intel 6700K | Dominator 2x16GB 3000MHz | Samsung 950 Pro 2x512GB NVMe RAID0 | MSI 1080 Gaming X | Seasonic 520 Fanless | 7260 HMV-AC | Fractal Design Define R4 | Noctua NH-U12S@475RPM | Noctua P12@475RPM x5
Supermicro X10SLL-F | Supermicro 1U SC813MT-300C | XEON E3 1231v3 | Hynix 4x8GB ECC | 840 EVO | WD 6x 4TB RE
x220 | IPS | i7 | SSD | 9-cell

Trädvy Permalänk
Medlem
Registrerad
Feb 2012
Skrivet av ggwp:

Det är för att dstRows referensten flyttar sig när du kör insert. Justera med .Offset

With dstRows
.EntireRow.Insert
.Offset(tplRows.rows,0).EntireRow.Hidden = False
End With

Det är pga attribut som .Hidden som kopieras med .Copy som vi föredrar att använda .PasteSpecial över .Paste och .Insert. På det sättet plockar man ut exakt vad man vill kopiera över. I detta fall kanske Paste:=xlPasteValuesAndNumberFormats eller Paste:=xlPasteFormulasAndNumberFormats vilket betyder att det gömda attributet inte följer med i kopieringen, utan följer destinationscellens attribut istället.

Jo har försökt men det fungerar inte så bra PasteSpecial skapar inte rader utan skriver över
Med insert innan så verkar det vara hidden + att av någon anledning kopierar den in dubbelt

Trädvy Permalänk
Medlem
Registrerad
Aug 2014
Skrivet av lappen81:

Jo har försökt men det fungerar inte så bra PasteSpecial skapar inte rader utan skriver över
Med insert innan så verkar det vara hidden + att av någon anledning kopierar den in dubbelt

Du förbereder med attlägga in de nya raderna in i arbetsboken först - innan du kopierar - med .EntireRow.Insert. Till exempel med en for loop

(du får se detta som ett exempel eft jag sitter på mobilen och inte kan kolla exakt var du ville ha de nya raderna.)
For i = 1 to tplRows.rows
--- dstRows.EntireRow.Insert
Next rw

.... koden med .Copy och .PasteSpecial fortsätter här, in i de nya tomma raderna.

EDIT: jag minns faktiskt inte om man kan kanske göra dstRows.EntireRow.Insert (tplRows.rows) vilket skulle vara betydligt cleanare

Z170-WS | Intel 6700K | Dominator 2x16GB 3000MHz | Samsung 950 Pro 2x512GB NVMe RAID0 | MSI 1080 Gaming X | Seasonic 520 Fanless | 7260 HMV-AC | Fractal Design Define R4 | Noctua NH-U12S@475RPM | Noctua P12@475RPM x5
Supermicro X10SLL-F | Supermicro 1U SC813MT-300C | XEON E3 1231v3 | Hynix 4x8GB ECC | 840 EVO | WD 6x 4TB RE
x220 | IPS | i7 | SSD | 9-cell