VBA sichtbare Spalten mehrerer Sheets in ein Sheet kopieren

[so.egal]

Hallo zusammen,

ist es möglich, nur die sichtbaren Spalten mehrerer Sheets in ein Sheet per VBA zu kopieren?

LG Tina

[Elex]

Hi

Das es geht ist dir wahrscheinlich bewusst, nur nicht wie.
Und wir müssten wenigstens wissen wie es am Ende aussehen soll. Nur von bestimmten Blättern? Alle Spalten dann nebeneinander oder untereinander oder ???

Gruß Elex

[so.egal]

Hi,

ich hab jetzt probeweise nen Code erstellt, der teilweise für ein Sheet funktioniert. Er übernimmt aber nicht die Formatierung. Ich habe dummerweise verbundene Zellen in den Sheets und befürchte, das könnte ein Problem werden. 

Es handelt sich In "Brief 1" um Seiten, die nebeneinander angeordnet sind. In "Brief Test" sollen die sichtbaren Seiten reinkopiert werden.
Jetzt sollen aus einem weiteren Sheet "Brief 2" die sichtbaren Seiten unter denen des ersten Sheets "Brief 1", kopiert werden. Und dann noch aus einem dritten Sheet "Brief 3", wieder darunter.

Könnte ich vielleicht so vorgehen:

Code:

Sub Copy()

Worksheets("Brief 1").Unprotect
Worksheets("Brief 2").Unprotect
Worksheets("Brief 3").Unprotect

Sheets("Brief 1").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy
Worksheets("Brief Test").Range("A1").PasteSpecial

Sheets("Brief 2").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy
Worksheets("Brief Test").Range("A29").PasteSpecial

Sheets("Brief 3").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy
Worksheets("Brief Test").Range("A58").PasteSpecial

Worksheets("Brief 1").Protect
Worksheets("Brief 2").Protect
Worksheets("Brief 3").Protect

End Sub

Aber dann bräuchte ich noch etwas im Code, was mir einen "Seitenumbruch" bei Zeile 29 und Zeile 58 setzt.

LG Tina

[Elex]

So ähnlich hätte ich es dir auch vorgeschlagen.

Code:

Sub Copy()

Sheets("Brief Test").Cells.Clear
Sheets("Brief 1").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy Sheets("Brief Test").Range("A1")
Sheets("Brief 2").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy Sheets("Brief Test").Range("A51")   'Range("A51") anpassen
Sheets("Brief 3").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy Sheets("Brief Test").Range("A101")

End Sub

Was die Ausrichtung des Druckbereiches angeht. Kopiere doch einfach in die erste Zeile der neuen Seite.
Das alles klappt aber eh nur bei gleichen Spaltenbreiten.

Gruß Elex

[Kuwer]

Hallo Elex,

Was die Ausrichtung des Druckbereiches angeht. Kopiere doch einfach in die erste Zeile der neuen Seite.

Du machst mich neugierig, wie das gehen würde?

Gruß Uwe

[Elex]

Ich schau da einfach mal ins Seitenlayout. Kann aber auch sein das wir das eigentliche Problem anders Raten.

[Kuwer]

Hallo Tina,

Aber dann bräuchte ich noch etwas im Code, was mir einen "Seitenumbruch" bei Zeile 29 und Zeile 58 setzt.

Code:

    Worksheets("Brief Test").HPageBreaks.Add Before:=Worksheets("Brief Test").Rows(29)
    Worksheets("Brief Test").HPageBreaks.Add Before:=Worksheets("Brief Test").Rows(58)

Gruß Uwe

[so.egal]

Hi nochmal,

jetzt ist ein weiteres Problem aufgetaucht. 
In den Zellen die kopiert werden sollen stehen Verknüpfungen, die genau so übernommen werden sollen. Die Verknüpfungen ändern sich aber. So wird aus ='KN 1-Sch'!S7 beispielsweise ='KN 1-Sch'!M7. Kann ich das irgendwie vermeiden?

Hier mein aktueller Code:

Code:

Sub Copy()

Worksheets("Brief 1").Unprotect
Worksheets("Brief 2").Unprotect
Worksheets("Brief 3").Unprotect

'kopiert sichtbare Zellen im Sheet im Bereich G1:GJ28 und fügt sie im Worksheet in A1 ein
Sheets("Brief 1").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy
Worksheets("Brief Test").Range("A1").PasteSpecial

Sheets("Brief 2").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy
Worksheets("Brief Test").Range("A29").PasteSpecial

Sheets("Brief 3").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy
Worksheets("Brief Test").Range("A58").PasteSpecial

'Seitenumbruch vor Zeilen 29 und 58
Worksheets("Brief Test").HPageBreaks.Add Before:=Worksheets("Brief Test").Rows(29)
Worksheets("Brief Test").HPageBreaks.Add Before:=Worksheets("Brief Test").Rows(58)

'Seitenumbruch vor Spalte G
Worksheets("Brief Test").Columns("G").PageBreak = xlPageBreakManual

'Seitenumbruch vor Spalte entfernen

Worksheets("Brief 1").Protect
Worksheets("Brief 2").Protect
Worksheets("Brief 3").Protect

End Sub

LG Tina

[Kuwer]

Hallo Tina,

teste mal damit:

Code:

Sub CopyMacro()
  Dim varQ As Variant

  Worksheets("Brief 1").Unprotect
  Worksheets("Brief 2").Unprotect
  Worksheets("Brief 3").Unprotect

  'kopiert sichtbare Zellen im Sheet im Bereich G1:GJ28 und fügt sie im Worksheet in A1 ein
  Sheets("Brief 1").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy
  varQ = Sheets("Brief 1").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Formula
  Worksheets("Brief Test").Range("A1").PasteSpecial
  Worksheets("Brief Test").Range("A1").Resize(UBound(varQ, 1), UBound(varQ, 2)).Formula = varQ

  Sheets("Brief 2").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy
  varQ = Sheets("Brief 2").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Formula
  Worksheets("Brief Test").Range("A29").PasteSpecial
  Worksheets("Brief Test").Range("A29").Resize(UBound(varQ, 1), UBound(varQ, 2)).Formula = varQ
  
  Sheets("Brief 3").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Copy
  varQ = Sheets("Brief 3").Range("G1:GJ28").SpecialCells(xlCellTypeVisible).Formula
  Worksheets("Brief Test").Range("A58").PasteSpecial
  Worksheets("Brief Test").Range("A58").Resize(UBound(varQ, 1), UBound(varQ, 2)).Formula = varQ
  
  'Seitenumbruch vor Zeilen 29 und 58
  Worksheets("Brief Test").HPageBreaks.Add Before:=Worksheets("Brief Test").Rows(29)
  Worksheets("Brief Test").HPageBreaks.Add Before:=Worksheets("Brief Test").Rows(58)
  
  'Seitenumbruch vor Spalte G
  Worksheets("Brief Test").Columns("G").PageBreak = xlPageBreakManual
  
  'Seitenumbruch vor Spalte entfernen
  Worksheets("Brief 1").Protect
  Worksheets("Brief 2").Protect
  Worksheets("Brief 3").Protect
End Sub

Noch ein Hinweis: Ein Makro Copy zu nennen, ist keine gute Idee, da es den Befehl schon gibt!

Gruß Uwe

[Kuwer]

Hallo,

hier noch eine komprimierte Variante über eine Schleife:

Code:

Sub CopyMacro2()
  Dim i As Long
  Dim rngF As Range
  Dim strZ() As String
  Dim varQ As Variant

  strZ = Split(",1,29,58", ",") 'Seitenanfangszeilen
  
  For i = 1 To UBound(strZ)
    With Sheets("Brief " & i).Range("G1:GJ28")
      .Parent.Unprotect
      varQ = .Formula
      For Each rngF In .SpecialCells(xlCellTypeFormulas)
        rngF.Formula = Application.ConvertFormula(rngF.Formula, xlA1, , xlAbsolute)
      Next rngF
      'kopiert sichtbare Zellen im Sheet im Bereich G1:GJ28 und fügt sie im Worksheet ein
      .SpecialCells(xlCellTypeVisible).Copy Worksheets("Brief Test").Cells(strZ(i), 1)
      .Formula = varQ
      .Parent.Protect
    End With
  Next i

  With Worksheets("Brief Test")
    .ResetAllPageBreaks
    'Seitenumbruch vor den im Array strZ hinterlegten Zeilen
    For i = 2 To UBound(strZ)
      .HPageBreaks.Add Before:=Worksheets("Brief Test").Rows(strZ(i))
    Next i
    'Seitenumbruch vor Spalte G
    .VPageBreaks.Add Before:=Tabelle3.Columns(7)
  End With
End Sub

Gruß Uwe