Storey 2018. aug. 26. 18:26 | válasz | #2384
Köszönöm a segítséget, de továbbra sem működik. Az alábbi makróról lenne szó! Sub Masolas() Dim WSJ As Worksheet, WSS As Worksheet, WSA, sor Dim usor As Integer, sor1 As Integer, sor2 As Integer, sor3 As Integer, sor4 As Integer, sor5 As Integer, sor6 As Integer Application.ScreenUpdating = False Set WSS = Sheets("Alap") Set WSA = Sheets("Második") Set WSJ = Sheets("Harmadik") If WSS.Range("E13") = "" Then MsgBox "Nincsenek másolható adatok!", vbOKOnly + vbExclamation Exit Sub End If '*************************************************************************** 'Előző adatok törlése WSA.Range("C10:G59, C68:G117, C126:G175, C184:G233, C242:G291, C300:G349") = "" WSJ.Range("C10:G59, C68:G117, C126:G175, C184:G233, C242:G291, C300:G349") = "" sor1 = 10: sor2 = 68: sor3 = 126: sor4 = 184: sor5 = 242: sor6 = 300 '*************************************************************************** WSS.Select usor = Range("E12").End(xlDown).Row For sor = 10 To usor Select Case Cells(sor, "G") Case Range("B6").Value Range("B" & sor & ":F" & sor).Copy WSA.Range("C" & sor1).PasteSpecial xlPasteValues Range("B" & sor & ":F" & sor).Copy WSJ.Range("C" & sor1).PasteSpecial xlPasteValues sor1 = sor1 + 1 Case Range("B7").Value Range("B" & sor & ":F" & sor).Copy WSA.Range("C" & sor2).PasteSpecial xlPasteValues Range("B" & sor & ":F" & sor).Copy WSJ.Range("C" & sor2).PasteSpecial xlPasteValues sor2 = sor2 + 1 Case Range("B8").Value Range("B" & sor & ":F" & sor).Copy WSA.Range("C" & sor3).PasteSpecial xlPasteValues Range("B" & sor & ":F" & sor).Copy WSJ.Range("C" & sor3).PasteSpecial xlPasteValues sor3 = sor3 + 1 Case Range("B9").Value Range("B" & sor & ":F" & sor).Copy WSA.Range("C" & sor4).PasteSpecial xlPasteValues Range("B" & sor & ":F" & sor).Copy WSJ.Range("C" & sor4).PasteSpecial xlPasteValues sor4 = sor4 + 1 Case Range("B10").Value Range("B" & sor & ":F" & sor).Copy WSA.Range("C" & sor5).PasteSpecial xlPasteValues Range("B" & sor & ":F" & sor).Copy WSJ.Range("C" & sor5).PasteSpecial xlPasteValues sor5 = sor5 + 1 Case Range("B11").Value Range("B" & sor & ":F" & sor).Copy WSA.Range("C" & sor6).PasteSpecial xlPasteValues Range("B" & sor & ":F" & sor).Copy WSJ.Range("C" & sor6).PasteSpecial xlPasteValues sor6 = sor6 + 1 End Select Next Application.CutCopyMode = False Application.ScreenUpdating = True Range("E13").Select End Sub A lényege az, hogy az egyik lapon vegyesen vannak az adatok (max 6 féle) amelyet másik két lapra válogat és másol át. A makró elindul, de csak az első elemet másolja át a lapokra, a többit nem. 2007 éa 2010 alatt tökéletesen működött, illetve van még jónéhány másik makró is ugyanebben az Excel fileban, amelyek tökéletesen működnek. Csak ez az egy nem. :( Előre is köszi!